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.14'; # 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__

=pod

=encoding UTF-8

=head1 NAME

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

=head1 VERSION

version 0.14

=head1 SYNOPSIS

This class is for internal use only.

=for stopwords Iron.io Params params API Mikko Koivunalho TODO

=for stopwords NoIronPolicyException IronPolicyException

=head1 METHODS

=head2 IRON_CLIENT_DEFAULT_POLICIES

Default policies for all clients.
These policies allow everything.

=head2 alternatives

Return all possible alternatives.

Parameters:

=over 8

=item required_policy, name/key name

=back

Return: List of possible alternatives if validation is successful.
If the policy is not set, throws a NoIronPolicyException.

=head2 is_valid_policy

Is this policy valid?

Parameters:

=over 8

=item policy, name/key name.

=item candidate, proposed string.

=back

Return: Boolean.

=head2 validate_with_policy

Validate a candidate string. Same as method is_valid_policy() but this method throws an exception of type IronPolicyException if the validation fails.

Parameters:

=over 8

=item policy, name/key name.

=item candidate, proposed string.

=back

Return: Boolean True if validation is successful, otherwise throws an exception.

=head2 get_policies

Get the policies from file or use the defaults. This function is for internal use.

The configuration is constructed as follows:

=over 8

=item 1. The global defaults.

=item 5. The policies file specified when instantiating the client library overwrites everything before it according to the file hierarchy.

=item 6. Return only the policies connected to this client (specify in derived class with method _THIS_POLICY).

=back

Return: ref to policies.

=head1 AUTHOR

Mikko Koivunalho <[e-mail]>

=head1 BUGS

Please report any bugs or feature requests to [e-mail] or through the web interface at:
 http://rt.cpan.org/Public/Dist/Display.html?Name=IO-Iron

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2023 by Mikko Koivunalho.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

The full text of the license can be found in the
F<LICENSE> file included with this distribution.

=cut