File Coverage

blib/lib/IO/Iron/PolicyBase.pm

Criterion	Covered	Total	%
statement	169	194	87.1
branch	21	32	65.6
condition	10	15	66.6
subroutine	24	25	96.0
pod	5	5	100.0
total	229	271	84.5

package IO::Iron::PolicyBase;

## no critic (Documentation::RequirePodAtEnd)
## no critic (Documentation::RequirePodSections)
## no critic (Subroutines::RequireArgUnpacking)

use 5.010_000;
use strict;
use warnings;

# Global creator
BEGIN {
    # Inherit nothing
}

# Global destructor
END {
}


# ABSTRACT: Base package (inherited) for IO::Iron::IronMQ/Cache/Worker::Policy packages.

our $VERSION = '0.12_01'; # TRIAL VERSION: generated by DZP::OurPkgVersion


use Log::Any  qw{$log};
use Hash::Util 0.06 qw{lock_keys unlock_keys};
use Carp::Assert;
use Carp::Assert::More;
use English '-no_match_vars';
use File::Spec ();
use Params::Validate qw(:all);
use Exception::Class (
      'IronPolicyException' => {
        fields => ['policy', 'candidate'],
      },
      'NoIronPolicyException' => {
        fields => [],
      },
      'CharacterGroupNotDefinedIronPolicyException' => {
        fields => [],
      }
  );

use IO::Iron::Common ();
use IO::Iron::PolicyBase::CharacterGroup ();


# INTERNAL METHODS
# For use in the inheriting subclass


# TODO policy character set, list possible alternatives:
sub IRON_CLIENT_DEFAULT_POLICIES {
    my %default_policies =
            (
            'definition' => {
                'character_set' => 'ascii', # The only supported character set!
                'character_group' => {
                },
                'no_limitation' => 1, # There is an unlimited number of alternatives.
            },
            'queue' => { 'name' => [ '[:word:]{1,}' ], },
            'cache' => { 'name' => [ '[:word:]{1,}' ], 'item_key' => [ '[:word:]{1,}' ]},
            'worker' => { 'name' => [ '[:word:]{1,}' ], },
            );
    return %default_policies;
}

sub _do_alt {
    my $self = shift;
    my %params = validate(
        @_, {
            'str' => { type => SCALAR, }, # name/key name.
        }
    );
    my $str = $params{'str'};
    $log->tracef('Entering _do_alt(%s)', $str);
    assert(length $str > 0, 'String length > 0.');
    my @processed_alts;
    if( $str =~ /^([[:graph:]]*)(\[:[[:graph:]]+:\]\{[[:digit:]]+\,[[:digit:]]+\})([[:graph:]]*)$/sx
            || ($str =~ /^([[:graph:]]*)(\[:[[:graph:]]+:\]\{([[:digit:]]+)\})([[:graph:]]*)$/sx && $3 > 1)
            ) {
        $log->tracef('We need to do recursion.', $str);
        my $preceeding_part = $1;
        my $group_part = $2;
        my $succeeding_part = defined $4 ? $4 : $3;
        $log->tracef('$preceeding_part=%s;$group_part=%s;$succeeding_part=%s;',
            $preceeding_part, $group_part, $succeeding_part);
        my @alternatives = _make_ones($preceeding_part, $group_part, $succeeding_part);
        foreach (@alternatives) {
            push @processed_alts, $self->_do_alt('str' => $_);
        }
    }
    else {
        $log->tracef('We need to create the alternatives.', $str);
        if( $str =~ /^([[:graph:]]*)(\[:[[:graph:]]+:\]\{1\})([[:graph:]]*)$/sx ) {
            my @alts;
            my $preceeding_part = $1;
            my $group_part = $2;
            my $succeeding_part = $3;
            $log->tracef('$preceeding_part=%s;$group_part=%s;$succeeding_part=%s;',
                $preceeding_part, $group_part, $succeeding_part);
            if($group_part =~ /^(\[:[[:graph:]]+:\])\{([[:digit:]]+)\}$/sx) {
                my $group = $1;
                my $lowest_amount = $2;
                my $highest_amount = $3;
                $log->tracef('$group=%s;$lowest_amount=%s;$highest_amount=%s;',
                    $group, $lowest_amount, $highest_amount);
                foreach ($self->_get_character_group_alternatives('character_group' => $group)) {
                    push @alts, $preceeding_part . $_ . $succeeding_part;
                }
            }
            $log->tracef('@alts=%s;', \@alts);
            foreach (@alts) {
                push @processed_alts, $self->_do_alt('str' => $_);
            }
        }
        else {
            push @processed_alts, $str;
        }
    }
    $log->tracef('Exiting _do_alt():%s', \@processed_alts);
    return @processed_alts;
}

sub _make_ones {
    my $preceeding_part = $_[0];
    my $group_part = $_[1];
    my $succeeding_part = $_[2];
    $log->tracef('_make_ones():$preceeding_part=%s;$group_part=%s;$succeeding_part=%s;',
        $preceeding_part, $group_part, $succeeding_part);
    $log->tracef('$group_part=%s;', $group_part);
    my @alternatives;
    if($group_part =~ /^(\[:[[:graph:]]+:\])\{([[:digit:]]+)\,([[:digit:]]+)\}$/msx) {
        my $group = $1;
        my $lowest_amount = $2;
        my $highest_amount = $3;
        $log->tracef('$group=%s;$lowest_amount=%s;$highest_amount=%s;',
            $group, $lowest_amount, $highest_amount);
        for($lowest_amount..$highest_amount) {
            my $group_str = $group . '{1}';
            push @alternatives, $preceeding_part . $group_str x $_ . $succeeding_part;
        }
    }
    elsif($group_part =~ /^(\[:[[:graph:]]+:\])\{([[:digit:]]+)\}$/msx) {
        my $group = $1;
        my $lowest_amount = $2;
        my $highest_amount = $2;
        $log->tracef('$group=%s;$lowest_amount=%s;$highest_amount=%s;',
            $group, $lowest_amount, $highest_amount);
        for(my $i = $lowest_amount; $i < $highest_amount + 1; $i++) {
            my $group_str = $group . '{1}';
            push @alternatives, $preceeding_part . $group_str x $i . $succeeding_part;
        }
    }
    else {
        $log->fatalf('Illegal string \'%s\'.', $group_part);
    }
    $log->tracef('@alternatives=%s;', \@alternatives);
    return @alternatives;
}

sub _get_character_group_alternatives {
    my $self = shift;
    my %params = validate(
        @_, {
            'character_group' => { type => SCALAR, regex => qr/^[[:graph:]]+$/msx, }, # name/key name.
            'keep_posix_group' => { type => BOOLEAN, optional => 1, }, # Keep POSIX (subset) group name and return it.
        },
    );
    my $chars;

    # Predefined groups (subset of POSIX) first!
    $chars = IO::Iron::PolicyBase::CharacterGroup::group(
            'character_group' => $params{'character_group'});
    if($chars && $params{'keep_posix_group'}) {
        $chars = $params{'character_group'}; # Put the group name back.
    }
    if(!$chars) {
        $chars = $self->{'policy'}->{'definition'}->{'character_group'}
                ->{$params{'character_group'}};
    }
    if($chars) {
        $log->tracef('$chars=%s;', $chars);
    }
    else {
        $log->fatalf('Character group \'%s\' not defined.', $params{'character_group'});
        CharacterGroupNotDefinedIronPolicyException->throw(
                error => 'CharacterGroupNotDefinedIronPolicyException: Character group \'' . $params{'character_group'} . '\' not defined!',
                );
    }
    return split //msx, $chars;
}


sub alternatives {
    my $self = shift;
    my %params = validate(
        @_, {
            'required_policy' => { type => SCALAR, }, # name/key name.
        }
    );
    assert_hashref( $self->{'policy'}, 'self->{required_policy} is a reference to a list.');
    $log->tracef('Entering alternatives(%s)', \%params);

    if(defined $self->{'policy'}->{'definition'}->{'no_limitation'} &&
            $self->{'policy'}->{'definition'}->{'no_limitation'} == 1) {
        NoIronPolicyException->throw(
                error => 'NoIronPolicyException: Cannot list alternatives, unlimited number!',
                );
    }
    my $templates = $self->{'policy'}->{$params{'required_policy'}};
    assert_listref($templates, 'templates is a reference to a list');
    my @template_alternatives;
    foreach (@{$templates}) {
        $log->tracef('alternatives(): Template:\"%s\".)', $_);
        push @template_alternatives, $self->_do_alt('str' => $_);
    }
    $log->tracef('Exiting alternatives():%s', \@template_alternatives);
    return @template_alternatives;
}

sub _get_chars_or_remain_posix_group {
    my $self = shift;
    $log->tracef('Entering _get_chars_or_remain_posix_group(%s)', \@_);
    my $group = $_[0];
    $log->tracef('_get_chars_or_remain_posix_group(): Ask for Group alternatives for :%s', $group);
    my @chars = $self->_get_character_group_alternatives('character_group' => $group, 'keep_posix_group' => 1);
    $log->tracef('_get_chars_or_remain_posix_group(): Group alternatives:%s', \@chars);
    my $group_chars = join q{}, @chars;
    $log->tracef('Exiting _get_chars_or_remain_posix_group():%s', ('[' . $group_chars . ']') );
    return '[' . $group_chars . ']';
}

sub _convert_policy_to_normal_regexp {
    my $self = shift;
    $log->tracef('Entering _convert_policy_to_normal_regexp(%s)', \@_);
    my $policy_regexp = $_[0];
    $policy_regexp =~ s/(\[:[[:graph:]]+?:\])/$self->_get_chars_or_remain_posix_group($1)/egsx;
    $log->tracef('Exiting _convert_policy_to_normal_regexp():%s', $policy_regexp);
    return $policy_regexp;
}


sub is_valid_policy {
    my $self = shift;
    my %params = validate(
        @_, {
            'policy' => { type => SCALAR, }, # name/key name.
            'candidate' => { type => SCALAR, }, # string to check.
        }
    );
    assert_listref( $self->{'policy'}, 'self->{policy} is a reference to a list.');
    $log->tracef('Entering is_valid_policy(%s)', \%params);

    my $validity = 0;
    if(defined $self->{'policy'}->{'definition'}->{'no_limitation'}
            && $self->{'policy'}->{'definition'}->{'no_limitation'} == 1) {
        $log->trace('is_valid_policy', 'no_limitation: no policy check!');
        $validity = 1;
    }
    else {
        my $templates = $self->{'policy'}->{$params{'policy'}};
        assert_listref($templates, "templates is a reference to a list");
        foreach (@{$templates}) {
            $log->tracef('is_valid_policy(): Going to comparing with raw template:\"%s\".)', $_);
            my $template = $self->_convert_policy_to_normal_regexp($_);
            $log->tracef('is_valid_policy(): Comparing with template:\"%s\".)', $template);
            if($params{'candidate'} =~ /^$template$/xgsm) {
                $validity = 1;
                last;
            }
        }
    }
    $log->tracef('Exiting is_valid_policy():%d', $validity);
    return $validity;
}

# This method throws an exception of type IronPolicyException.


sub validate_with_policy {
    my $self = shift;
    my %params = validate(
        @_, {
            'policy' => { type => SCALAR, }, # name/key name.
            'candidate' => { type => SCALAR, }, # string to check.
        }
    );
    assert_hashref( $self->{'policy'}, 'self->{policy} is a reference to a hash.');
    $log->tracef('Entering validate_with_policy(%s)', \%params);
    my $validity = 0;
    my $templates = $self->{'policy'}->{$params{'policy'}};
    assert_listref($templates, 'templates is a reference to a list');
    foreach (@{$templates}) {
        my $template = $self->_convert_policy_to_normal_regexp($_);
        $log->tracef('validate_with_policy(): Comparing with template:\"%s\".)', $template);
        if($params{'candidate'} =~ /^$template$/xgsm) {
            $validity = 1;
            last;
        }
    }
    if($validity == 0) {
        $log->tracef('Throwing exception in validate_with_policy(): policy=%s, candidate=%s', $params{'policy'}, $params{'candidate'});
        IronPolicyException->throw(
                policy => $params{'policy'},
                candidate => $params{'candidate'},
                error => 'IronPolicyException: policy=' . $params{'policy'}
                    . ' candidate=' . $params{'candidate'},
                );
    }
    $log->tracef('Exiting validate_with_policy():%d', $validity);
    return $validity;
}


sub get_policies { ## no critic (Subroutines::RequireArgUnpacking)
    my $self = shift;
    my %params = validate(
        @_, {
            'policies' => { type => SCALAR|UNDEF, optional => 0, },
        }
    );
    $log->tracef('Entering get_policies(%s)', \%params);
    my %all_policies = IRON_CLIENT_DEFAULT_POLICIES(); ## Preset default policies.
    $log->tracef('Default policies: %s', \%all_policies);
    if(defined $params{'policies'}) { # policies file specified when creating the object, if given.
        IO::Iron::Common::_read_iron_config_file(\%all_policies,
                File::Spec->file_name_is_absolute($params{'policies'})
                ? $params{'policies'} : File::Spec->catfile(File::Spec->curdir(), $params{'policies'})
                );
    }
    my %policies = %{$all_policies{$self->_THIS_POLICY()}};
    $policies{'definition'} = $all_policies{'definition'};
    $log->tracef('Exiting get_policies: %s', \%policies);
    return \%policies;
}

1;

__END__