#
# Copyright (c) 2001-2017 NetApp, Inc., All Rights Reserved
#   Any use, modification, or distribution is prohibited
#   without prior written consent from NetApp, Inc.
#

## @summary Module that provides methods for choosing which APISet to use
## @author dl-nacl-dev@netapp.com
## @status shared
## @pod here

=head1 NAME

NACL::ChooseAPISet

=head1 DESCRIPTION

Provide methods to Component and ComponentState objects for choosing
which APISets to use (based on "apiset_must"/"apiset_should" values).

Both NACL::C::Component and NACL::CS::ComponentState import routines
from this library, which in turn show up in all of their derived
classes through inheritance.

=begin COMMENTED_OUT

=head1 DATA TYPES

There should be a description here of the type of "rule set" value
that C<apiset_must> and C<apiset_should> are an example of, and what
such a value represents.

Also the "xyz_source" keys in addition to "xyz".

=end COMMENTED_OUT

=cut

package NACL::ChooseAPISet;

use strict;
use warnings;
use feature 'state';

use Params::Validate qw(:all);
use NATE::Log qw(log_global);
my $Log = log_global();
my $may_enter = $Log->may_enter();
my $may_exit  = $Log->may_exit();
use NACL::Exceptions::InvalidChoice qw(:try);
use Storable qw(dclone);
use Scalar::Util qw(blessed);
use NACL::ComponentUtils qw(Dumper _is_nacl_lib_loaded);
use Math::Random::MT::Auto ':!auto';
use NATE::Events qw(call_on_fork_add);
use NACL::APISet;
use Module::Load ();

my $Infinity = 9**9**9;

# Uses the Merseinne-Twister algorithm, which is superior to what Perl
# uses. Also, being a separate object, it is a separate RNG just for this
# purpose (can't be affected by external calls)
my $Global_MT_Obj = Math::Random::MT::Auto->new();

# On fork we want to re-seed so that children running in parallel
# do not end up generating the same random numbers. The self-seeding
# of Math::Random::MT::Auto seems sufficient here.
call_on_fork_add(
    {   callback     => sub { $Global_MT_Obj->srand(); },
        keep_on_fork => 1,
    },
);

BEGIN {
    use Exporter qw(import);
    our @EXPORT_OK = qw(call_on_apiset ruleset_keys ruleset_allowed
        call_on_apiset_with_exceptions);
}

=head1 METHODS

=head2 call_on_apiset

    package NACL::C::Widget;
    use base qw(NACL::C::Component);

    sub frontend {
        my $pkg_or_obj = shift;
        $pkg_or_obj->call_on_apiset(@_,
                                    choices => [
                                                {
                                                 method=>"backend1",
                                                 interface=>"CLI",
                                                 set=>"7Mode",
                                                },
                                                {
                                                 method=>"backend2",
                                                 interface=>"ZAPI",
                                                 set=>"CMode",
                                                },
                                               ],
                                   );
    }

    sub backend1 { ... }
    sub backend2 { ... }


A helper for constructing public "front end" methods of components,
where the method promises to provide the same functionality over
multiple types of NACL::APISet (most commonly in order to support both
"7Mode" and "CMode" modes/sets or both "CLI" and "ZAPI" interfaces).
The real work is performed by one or more private "back end" methods
on the same package or object as the front end.  Each backend method
generally implements only one type of APISet (though if multiple
APISets differ only in how they're constructed but provide the same
requests/responses, the same backend method may be used)

The front end methods end up taking the following options:

    command_interface
    apiset_must
    apiset_should
    zapi_type (only if both iter and non_iter are supported for
        particular zapi operation)
    When zapi_type is specified for non_iter zapi back end method,
    it is necessary to add zapi_type for all choices. zapi_type can
    take 'non-iter', 'iter' and 'none' value. 'none' value is used for
    non-zapi choices.
    (anything else specific to the method)

and then call the backend method with these options

    command_interface (same value as passed to front end)
    apiset (a NACL::APISet)
    (anything else specific to the method, same values as passed to front end)

=over

=item Options

=over

=item C<< command_interface=>$command_interface >>

The NACL::C::CommandInterface to use.  The command interface itself
provides hints as to which ...

=item C<< do_not_call_backend => 1 >>

(Optional) This is a flag which default to 0,when set to 1 ,it wont call the
backend method and  it returns the apiset and backend method chosen in a
hash-reference.
The hash-reference will be of this form:

    {
        apiset => bless (),
        backend_method => '_create_7mode_cli'
    }

=item C<< apiset_backend_already_chosen => $apiset_backend >>

(Optional) A hashref which contains apiset and backend method ,when passed this function wont
compute which backend method to call and apiset object to use . It will use the apiset object and
call the backend method which is provided in the hash.

=back

=back

=cut

sub call_on_apiset {
    my ($pkg_or_obj, @args) = @_;
    $Log->enter() if $may_enter;
    my %opts = validate_with(
        params => \@args,
        spec   => {
            command_interface   => {isa  => "NACL::C::CommandInterface"},
            apiset_must         => {type => HASHREF, default => {}},
            apiset_should       => {type => HASHREF, default => {}},
            choices             => {type => ARRAYREF},
            apiset_chosen       => {type => SCALARREF, optional => 1},
            do_not_call_backend => {type => SCALAR, default => 0},
            apiset_backend_already_chosen => {type => HASHREF, default => {}},
            frontend => {type => SCALAR, optional => 1},
        },

        # These are the options that should be sent through to the
        # back-end method
        allow_extra => 1,
    );
    my $opts_apiset_must   = delete $opts{apiset_must};
    my $opts_apiset_should = delete $opts{apiset_should};
    my $original_choices   = delete $opts{choices};
    my $command_interface  = delete $opts{command_interface};
    my $apiset_chosen      = delete $opts{apiset_chosen};
    my $apiset_backend_already_chosen
        = delete $opts{apiset_backend_already_chosen};
    my $do_not_call_backend = delete $opts{do_not_call_backend};

    my $front = delete $opts{frontend};
    if (!defined $front) {
        if ($pkg_or_obj->isa('NACL::CS::ComponentState')) {

            # In CS packages, the call to call_on_apiset is in the base
            # class, so the front-end is one level further back
            $front = (caller(2))[3];
        } else {
            $front = (caller(1))[3];
        }
    }

    my $choices = dclone($original_choices);
    my ($apiset, $method);

    # We're going to store temporary notes to ourselves in the choices
    # array, so make a deep copy of it.
    #   (This may not strictly be necessary, since our front-end
    #   caller tends to pass us a temporary value it constructed)
    if (!keys %$apiset_backend_already_chosen) {
        #############################################################
        # Gather apiset_must settings.
        #
        # This is done by computing a $full_apiset_must rule set, which is
        # at least as constraining as any of the "apiset_must" rule sets
        # that are among our inputs.
        #############################################################

        my $ci_apiset_must = $command_interface->apiset_must();
        my $ci_default_apiset_must
            = $command_interface->default_apiset_must();

        # Specify the source for each of the values provided
        # in apiset_must through the script.
        my %opts_apiset_must_hash = %{$opts_apiset_must};
        while (my ($key, $value) = each %opts_apiset_must_hash) {
            next if ($key =~ /_source$/);
            my $key_source = "${key}_source";
            if (!exists $opts_apiset_must_hash{$key_source}) {
                $opts_apiset_must_hash{$key_source} = 'Provided in the '
                    . 'method call';
            }
        }

        # Flip the order so that the order of precedence is:
        # default setting; setting in CI; setting provided in script
        my @apiset_musts = (

            # Rules this CI always obeys
            $ci_default_apiset_must,

            # Rules the user/hostrec told this CI to obey
            $ci_apiset_must,

            # Rules passed as an option to us just now
            \%opts_apiset_must_hash,
        );

        # Remove empties (no change in behavior, but faster)
        @apiset_musts = grep { keys %$_ } @apiset_musts;
        _pick_interface_if_random($pkg_or_obj, \@apiset_musts);

        $Log->debug(
            sub {
                "$front apiset_must settings: "
                    . Data::Dumper::Dumper(\@apiset_musts);
            }
        );

        # Collapse into a single hash
        my $full_apiset_must    = {};
        foreach my $apiset_must (@apiset_musts) {
            $full_apiset_must = {%{$full_apiset_must}, %{$apiset_must}};
        }


        #############################################################
        # Gather apiset_should settings
        #############################################################

        # The calls to dclone() are to ensure that we don't end up modifying
        # any references passed in

        # Specify the source for each of the values provided
        # in apiset_must through the script.
        my %opts_apiset_should_hash = %{$opts_apiset_should};
        while (my ($key, $value) = each %opts_apiset_should_hash) {
            next if ($key =~ /_source$/);
            my $key_source = "${key}_source";
            if (!exists $opts_apiset_should_hash{$key_source}) {
                $opts_apiset_should_hash{$key_source} = 'Providing in the '
                    . 'method call';
            }
        }

        # Flip the order so that the order of precedence is:
        # default setting; setting in CI; setting provided in script
        my @apiset_shoulds = (

            # Preference this CI always has
            scalar($command_interface->default_apiset_should()),

            # Preference the user/hostrec told this CI to obey
            scalar($command_interface->apiset_should()),

            # Preference passed as an option to us just now
            \%opts_apiset_should_hash,
        );

        # Remove empties (no change in behavior, but faster)
        @apiset_shoulds = grep { keys %{$_} } @apiset_shoulds;

        _pick_interface_if_random($pkg_or_obj, \@apiset_shoulds);

        $Log->debug(
            sub {
                "$front apiset_should settings: "
                    . Data::Dumper::Dumper(\@apiset_shoulds);
            }
        );

        # Collapse into a single should hash
        my $full_apiset_should    = {};
        foreach my $apiset_should (@apiset_shoulds) {
            $full_apiset_should = {%{$full_apiset_should}, %{$apiset_should}};
        }

        #############################################################
        # Go though each of the choices, marking ones that don't match the
        # "apiset_must" rules as infinitely bad, and marking others with
        # badness equal to how many "apiset_should" rules they don't
        # match.
        #############################################################

    CHOICE:
        foreach my $i (0 .. $#$choices) {
            my $choice          = $choices->[$i];
            my $original_choice = $original_choices->[$i];
            $choice->{badness} = 0;

            # Weed out choices that don't match apiset_must

            my $impossible_rule_key = _ruleset_intersect(
                target  => $choice,
                sources => [$full_apiset_must]
            );
            if ($impossible_rule_key) {
                $choice->{badness}           = $Infinity;
                $choice->{not_chosen_reason} = (
                    _explain_must("method", $original_choice,
                        $impossible_rule_key)
                        . _explain_must(
                        "$front apiset_must option", $opts_apiset_must,
                        $impossible_rule_key
                        )
                        . _explain_must(
                        "command interface's apiset_must", $ci_apiset_must,
                        $impossible_rule_key
                        )
                        . _explain_must(
                        "command_interface's default_apiset_must",
                        $ci_default_apiset_must,
                        $impossible_rule_key
                        )
                );
                next CHOICE;
            }

            # Rate the choice by how well it matches apiset_should


                my @impossible_rule_keys = _ruleset_intersect(
                    target  => $choice,
                    sources => [$full_apiset_should]
                );

                # Increase the badness count by the number of keys
                # for which there was a mismatch. If there was no
                # mismatch, then the badness value would end up remaining
                # the same
                $choice->{badness} += @impossible_rule_keys;
        }

        #############################################################
        # Sort the choices in place by badness (good ones first)
        #############################################################

        use sort 'stable';
        our $a;
        our $b;
        @$choices = sort { $a->{badness} <=> $b->{badness} } @$choices;

        my $first_choice = $choices->[0];

        # Apply the "check" conditions if there are good choices
        if ($first_choice->{badness} < $Infinity) {

            foreach my $choice (@$choices) {

              # Iterate through this sorted list till we find a method which
              # does not fail the "check" method
              # (call that method if defined for this choice, see if it fails)

                if ($choice->{check}) {
                    my $check = $choice->{check};
                    try {
                        $pkg_or_obj->$check(
                            %opts,
                            command_interface => $command_interface,
                            _method           => $front
                        );
                        $first_choice = $choice;
                        no warnings qw(exiting);
                        last;
                    }
                    catch NACL::Exceptions::InvalidChoice with {
                        my $exception_object = shift;
                        $choice->{badness} = $Infinity;
                        $choice->{not_chosen_reason}
                            = $exception_object->text();
                    };
                } else {
                    $first_choice = $choice;
                    last;
                }
            }
        }

        use warnings qw(exiting);

        ##################################################################
        # Check and complain if all choices are bad or do not pass "check"
        # (If, after sorting, the first one is bad, they're all bad)
        ##################################################################

        if ($first_choice->{badness} >= $Infinity || !defined $first_choice) {
            my $message
                = "None of the available interfaces/modes for method '$front' are allowed for this command interface:\n";
            foreach my $choice (@$choices) {
                $message
                    .= "  "
                    . $choice->{method}
                    . " not chosen because:\n    "
                    . NATE::Util::indent(4, $choice->{not_chosen_reason})
                    . "\n";
            }
            $Log->exit() if $may_exit;
            NACL::Exceptions::InvalidChoice->throw($message);
        }

        #############################################################
        # The first choice is compatible (or is the least incompatible)
        # with the given "apiset_should" selection(s), but it may still
        # allow other possibilities.  Try to specialize it to one of the
        # apiset_should selection(s) wherever we can.
        #############################################################

        my %new_choice = %{$first_choice};
        my $impossible_rule_key = _ruleset_intersect(
            target  => \%new_choice,
            sources => [$first_choice, $full_apiset_should]
        );
        if (!$impossible_rule_key) {
            $first_choice = \%new_choice;
        }

        $Log->debug(
            "$front first choice: " . Data::Dumper::Dumper($first_choice));

        #############################################################
        # Compute the options to the apiset constructor from the first
        # choice.
        #
        # (If the first choice doesn't list a particular key, so none of
        # the choices, apiset_musts, or apiset_coulds bothered to specify,
        # but it's a required key like "category", "interface", or "set",
        # then use the command interface's default_apiset_could, whose
        # purpose is to resolve these sorts of indecisions)
        #
        # (If the first choice's key still has multiple possibilities
        # e.g. key=>"A|B" to mean A or B, then pick the first possibility
        # given for that key)
        #############################################################

        my %apiset_new_opts;
        my $default_apiset_could = $command_interface->default_apiset_could();
        foreach my $rule_key (ruleset_keys()) {
            my $value = $first_choice->{$rule_key};
            if (!defined $value) {
                $value = $default_apiset_could->{$rule_key};
            }
            next if !defined $value;
            my $first_value;
            if (ref $value) {
                $apiset_new_opts{$rule_key} = $value;
            } else {
                my @all_values = split /\|/, $value;
                $apiset_new_opts{$rule_key} = $all_values[0];
            }
        }

        #############################################################
        # Construct or fetch an APISet that matches our chosen rules
        #############################################################

        #delete zapi_type from %apiset_new_opts
        delete $apiset_new_opts{zapi_type};

        $apiset = $command_interface->apiset(%apiset_new_opts);

        if ($apiset_chosen) {
            $$apiset_chosen = $apiset;
        }

        $method = $first_choice->{method};
        if ($do_not_call_backend) {
            my $apiset_backend = {};
            $apiset_backend->{apiset}         = $apiset;
            $apiset_backend->{backend_method} = $method;
            $Log->exit() if $may_exit;
            return $apiset_backend;
        }
    } else {
        if (   exists $apiset_backend_already_chosen->{apiset}
            && exists $apiset_backend_already_chosen->{backend_method}) {
            if (blessed $apiset_backend_already_chosen->{apiset}) {
                if (!$apiset_backend_already_chosen->{apiset}
                    ->isa('NACL::APISet')) {
                    $Log->exit() if $may_exit;
                    NATE::Exceptions::Argument->throw(
                        "apiset is not an APISet object in apiset_backend_already_chosen\n"
                            . Data::Dumper::Dumper(
                            $apiset_backend_already_chosen->{apiset}
                            )
                    );
                }
            } else {
                $Log->exit() if $may_exit;
                NATE::Exceptions::Argument->throw(
                    "apiset is not an object in apiset_backend_already_chosen\n"
                        . Data::Dumper::Dumper(
                        $apiset_backend_already_chosen->{apiset}
                        )
                );
            }

            if (ref $apiset_backend_already_chosen->{backend_method}) {
                $Log->exit() if $may_exit;
                NATE::Exceptions::Argument->throw(
                    "backend method name is not a scalar in apiset_backend_already_chosen\n"
                        . Data::Dumper::Dumper(
                        $apiset_backend_already_chosen->{backend_method}
                        )
                );
            }
        } else {
            $Log->exit() if $may_exit;
            NATE::Exceptions::Argument->throw(
                      "Atleast one of 'apiset' or 'method' missing in "
                    . "'apiset_backend_already_chosen':\n"
                    . NACL::ComponentUtils::Dumper(
                    $apiset_backend_already_chosen)
            );
        }

        $apiset = $apiset_backend_already_chosen->{apiset};
        $method = $apiset_backend_already_chosen->{backend_method};
    }

    #############################################################
    # Do some post processing on the other apiset options
    #
    # (This doesn't have to do with ChooseAPISet's purpose of choosing
    # the proper apiset, but this was apparently a convenient place
    # for this stuff that want to do for all component(state) methods)
    #############################################################

    if ($pkg_or_obj->isa('NACL::C::Component')) {

        # We need to determine the string form of any options that might
        # be passed as objects.
        $pkg_or_obj->_process_options(options => \%opts);
    } elsif ($pkg_or_obj->isa('NACL::CS::ComponentState')) {

        # 'call_on_apiset' invoked with a ComponentState object/package name.
        # The filter may include values being objects, we need to determine
        # the string form of these.
        $pkg_or_obj->_process_options(options => $opts{filter});
    }

    if ($apiset->{interface} eq 'ZAPI') {

       # Handle quotes here.
       # Values with special characters (like say qtree => qtree*) need to be
       # quoted for the CLI, i.e. would be '"qtree*"'. However, ZAPIs complain
       # for values with quotes in them - the value should be sent without
       # quotes. For this reason, analyze all options and strip out quotes
       # from any values to are contained with quotes.
        my $contained_in_quotes_regex = qr/^"(.*)"$/;
        while (my ($key, $value) = each %opts) {
            if (!ref $value) {

                # Value is a scalar
                if ($value =~ $contained_in_quotes_regex) {
                    $opts{$key} = $1;
                }
            } elsif (ref $value eq 'ARRAY') {

                # Value is an array
                if (grep {$contained_in_quotes_regex} @$value) {

                    # At least one of the values is contained in quotes
                    # Do NOT update the original array-reference, because
                    # that would modify the reference passed in by the user.
                    # Create a new array and update it.
                    my @new_array;
                    foreach my $single_val (@$value) {
                        if ($single_val =~ $contained_in_quotes_regex) {
                            push @new_array, $1;
                        } else {
                            push @new_array, $single_val;
                        }
                    }
                    $opts{$key} = \@new_array;
                }
            }
        }
    }

    #############################################################
    # Call the first choice's method (the appropriate "back end
    # method")
    #############################################################
    my %args = (
        apiset            => $apiset,
        command_interface => $command_interface,
        %opts
    );

    my (@ret_values, $timeout, $match, $original_timeout);
    my $retries        = $command_interface->retries();
    my $retry_interval = $command_interface->retry_interval();
    my @exceptions     = $command_interface->exceptions_to_retry();
    my @error_texts    = $command_interface->error_texts_to_retry();
    my @error_texts_to_ignore    = $command_interface->error_texts_to_ignore();
    my @exceptions_to_ignore    = $command_interface->exceptions_to_ignore();


    if (exists $args{'method-timeout'}) {

        $timeout = delete $args{'method-timeout'};

        $Log->trace("Setting timeout $timeout for method $method");

        # If 'method-timeout' was provided then we need to set the
        # APISet object to have this be its timeout value.
        # We extract the current timeout, set the new timeout, call the
        # backend method and then reset the timeout to the original value

        $original_timeout = $apiset->get_timeout();

       # The timeout range allowed by underlying Net::SNMP->timeout() is 1-60
       # sec. Hence if a user specifies timeout value greater than 60 (because
       # CLI, ZAPI allows and so we cannot expect users to handle this
       # difference for SNMP, then it wont be an interface agnostic behavior),
       # we will reset it to the max possible timeout of 60.
        if ($apiset->{interface} eq 'SNMP') {
            if ($timeout > 60) {
                $Log->trace("Resetting the SNMP timeout '$timeout' to 60");
                $timeout = 60;
            }
        }
        $apiset->set_timeout(timeout => $timeout);
    }
RETRY: {
        use warnings qw(exiting);
        $match = 0;
        try {
            @ret_values = $pkg_or_obj->$method(%args);
        }
        catch NATE::BaseException with {
            my $thrown_exception = $_[0];

            # error text to ignore, if specified,  takes the precedence.
            foreach my $err_text (@error_texts_to_ignore) {
                if ($thrown_exception->text() =~ /$err_text/i) {
                    # If ignore test is match, ignore error completely.
                    # What to set the return value ?

                    $Log->debug(
                        "Ignore error pattern matched: $err_text" );

                    no warnings 'exiting';
                    last RETRY;
                }
            }

            foreach my $exception (@exceptions_to_ignore) {
                if ($thrown_exception->isa($exception)) {
                    # If ignore exception is match, ignore exception completely.

                    $Log->debug(
                        "Thrown Exception is in ignore list: $exception" );

                    no warnings 'exiting';
                    last RETRY;
                }
            }

            foreach my $exception (@exceptions) {
                if ($thrown_exception->isa($exception)) {
                    $match = 1;
                    $Log->debug(
                        "Retry exception matched: $exception" );
                    last;
                }
            }
            if (   $match
                && $retries > 0) {
                --$retries;
                Tharn::sleep($retry_interval);
                no warnings qw(exiting);
                redo RETRY;
            }
            foreach my $err_text (@error_texts) {
                if ($thrown_exception->text() =~ /$err_text/i) {
                    $Log->debug(
                        "Retry error pattern matched: $err_text" );
                    $match = 1;
                    last;
                }
            }
            if ($match && $retries > 0) {
                --$retries;
                Tharn::sleep($retry_interval);
                no warnings qw(exiting);
                redo RETRY;
            }
            $thrown_exception->throw();
        }
        finally {

            # Regardless of whether an exception was thrown, we need to
            # reset the timeout value
            $apiset->set_timeout(timeout => $original_timeout)
                if ($original_timeout);
        };
    }
    # in case it exited from 'error text to ignore'
    use warnings qw(exiting);
    $Log->exit() if $may_exit;
    return wantarray ? @ret_values : $ret_values[0];

} ## end sub _call_on_apiset_helper

=head2 call_on_apiset_with_exceptions

A simple wrapper around L<call_on_apiset|lib-NACL-ChooseAPISet-pm/call_on_apiset> that takes care of also invoking
C<detect_convert_and_throw> on the specified exceptions. Code that used
to classify exceptions like this:

    try {
        $pkg->call_on_apiset(%opts);
    } catch NACL::APISet::Exceptions::ResponseException with {
        my $exception = $_[0];
        
        NACL::C::Exceptions::Foo::Exception1->detect_convert_and_throw(exception => $exception);
        NACL::C::Exceptions::Foo::Exception2->detect_convert_and_throw(exception => $exception);
        
        $Log->exit() if $may_exit;
        $exception->throw();
    };

Can be replaced by:

    $pkg->call_on_apiset(%opts, nacl_exceptions => [qw(Exception1 Exception2)]);

Here, C<nacl_exceptions> is an array-reference of exception names, which is
only the last part of the exception name ("Exception1") as opposed to the
complete exception name ("NACL::C::Exceptions::Foo::Exception1").

=cut

sub call_on_apiset_with_exceptions {
    $Log->enter() if $may_enter;
    my ($pkg_or_obj, @args) = @_;
    state $spec = {nacl_exceptions => {type => ARRAYREF, default => []}};
    my %opts = validate_with(
        params => \@args,
        spec   => $spec,
        
        # All other options will be validated by call_on_apiset
        allow_extra => 1,
    );
    my $exceptions = delete $opts{nacl_exceptions};
    my @ret_values;
    try {
        @ret_values = $pkg_or_obj->call_on_apiset(%opts);
    } catch NACL::APISet::Exceptions::ResponseException with {
        my $exception_obj = $_[0];
        
        my $pkg = $pkg_or_obj->get_package_name();
        
        # Package name will be of the form NACL::(C|STask)::Foo
        $pkg =~ /NACL::.*::(.*)/;
        my $comp_name = $1;
        
        # This will be NACL::C::Exceptions::Foo::
        my $partial_exception = "NACL::C::Exceptions::${comp_name}::";
        foreach my $exception (@$exceptions) {
            # Construct the full exception name - NACL::C::Exceptions::Foo::SomeException
            my $full_ex_name = $partial_exception . $exception;
            if( !_is_nacl_lib_loaded($full_ex_name) ) {
		try {
		    Module::Load::load($full_ex_name);
		} catch NATE::BaseException with {
		    my $real_pkg;
		    eval {$real_pkg = $pkg_or_obj->_real_component();};
		    if ( !($@) ) {
			$real_pkg =~ /NACL::.*::(.*)/;
			my $real_comp_name = $1;
			my $real_partial_exception = "NACL::C::Exceptions::${real_comp_name}::";
			$full_ex_name = $real_partial_exception . $exception;
		    }
		    Module::Load::load($full_ex_name);
		}
	    }
            $full_ex_name->detect_convert_and_throw(exception => $exception_obj);
        }
        
        $Log->exit() if $may_exit;
        $exception_obj->throw();
    };

    $Log->exit() if $may_exit;
    return wantarray ? @ret_values : $ret_values[0];
}

# updates the "target" ruleset to fold in the various source rulesets,
# where the combinations allowed by the final target ruleset will be
# the intersection of the combinations allowed by the original target
# ruleset and all of the source rulesets.

# (returns undef if intersection is non-empty, or if it's empty then
# it returns the name of the key whose value being empty is making the
# whole intersection empty)

# (sources should be in order of most authoritative to least
# authoritative, since merging rulesets together tends to follow the
# order of the earliest source)

sub _ruleset_intersect {
    $Log->enter() if $may_enter;
    my (%opts) = validate @_,
        {
        target  => {type => HASHREF},
        sources => {type => ARRAYREF},
        };
    my @impossible_rule_keys = ();
    my $target              = $opts{target};

    foreach my $rule_key (ruleset_keys()) {
        my $target_rule = $target->{$rule_key};

        foreach my $source (@{$opts{sources}}) {
            my $source_rule = $source->{$rule_key};

            # Now fold in each source rule by setting
            # $target_rule = intersect($target_rule,$source_rule)

            if (!$source_rule) {

                # No value means the infinite set (allow anything), so
                #         $target_rule = intersect($target_rule,$source_rule)
                # becomes $target_rule = intersect($target_rule,infinity)
                # becomes $target_rule = $target_rule
                # becomes "Do nothing"
            } elsif (!$target_rule) {

                # No value means the infinite set (allow anything), so
                #         $target_rule = intersect($target_rule,$source_rule)
                # becomes $target_rule = intersect(infinity,$source_rule)
                # becomes $target_rule = $source_rule
                $target_rule = $source_rule;
            } else {

                # Ah, finally some actual finite sets to intersect

                # Less space and time consumed when terse = 1 and indent = 0
                my $my_dumper = sub {
                    local $Data::Dumper::Terse  = 1;
                    local $Data::Dumper::Indent = 0;
                    return Data::Dumper::Dumper(@_);
                };

                # Turn the rules into hashes. By making them hashes, we can
                # quickly compare to form the intersections.
                # For simple scalar values, the rule is split on pipe and
                # each of the subsequent values are the keys and values of
                # the hash.
                # If the rule is a reference, then stringify it using Dumper.
                # This is the key of the hash, and the value is the original
                # reference.
                my $construct_hash = sub {
                    my ($rule) = validate_pos(@_, 1);

                    my %hash;
                    if (ref $rule) {
                        my $key = $my_dumper->($rule);
                        $hash{$key} = $rule;
                    } else {
                        my @list = split /\|/, $rule;
                        map { $hash{$_} = $_ } @list;
                    }

                    return %hash;
                };

                my %source_hash = $construct_hash->($source_rule);
                my %target_hash = $construct_hash->($target_rule);

                my @intersection;
                foreach my $key (keys %target_hash) {
                    if (exists $source_hash{$key}) {
                        push @intersection, $source_hash{$key};
                    }
                }

                # Note: For a single value we cannot use join. This is because
                # it is possible that the single intersection is a structure
                # (such as a Connectrec object). join() ends up stringifying
                # all values, so in that case $target_rule will end up being
                # something like "Connectrec=HASH(HEXNO)" rather than the
                # connection object.
                if (@intersection == 1) {
                    $target_rule = $intersection[0];
                } else {
                    $target_rule = join '|', @intersection;
                }
            }
        }
        if (defined($target_rule)) {
            if (length($target_rule)) {
                $target->{$rule_key} = $target_rule;
            } else {
                push @impossible_rule_keys, $rule_key;
            }
        }
    }
    $Log->exit() if $may_exit;
    return wantarray ? @impossible_rule_keys : $impossible_rule_keys[0];
} ## end sub _ruleset_intersect

# ...

sub _explain_must ( $$$ ) {
    $Log->enter() if $may_enter;
    my ($title, $ruleset, $key) = @_;
    if (!$ruleset) {
        $Log->exit() if $may_exit;
        return "";
    }
    my $rule = $ruleset->{$key};
    if (!defined($rule)) {
        $Log->exit() if $may_exit;
        return "";
    }

    # $rule =~ s/\|/ or /g;  # worse or better?
    my $source_msg = "";
    my $source     = $ruleset->{"${key}_source"};
    if ($source) {
        $source_msg = " ($source)";
    }
    $Log->exit() if $may_exit;
    return "$title says: '$key' must be $rule$source_msg\n";
} ## end sub _explain_must ( $$$ )

# ...

sub ruleset_allowed {
    $Log->enter() if $may_enter;
    my (%opts) = @_;
    my $impossible_column = _ruleset_intersect(
        target  => {},
        sources => $opts{rulesets}
    );
    $Log->exit() if $may_exit;
    return !$impossible_column;
} ## end sub ruleset_allowed

# ...

sub ruleset_keys {
    $Log->enter() if $may_enter;
    my %spec = NACL::APISet->get_validation_spec();
    my @keys = keys %spec;
    push @keys, 'zapi_type';
    $Log->exit() if $may_exit;
    return @keys;
} ## end sub ruleset_keys

sub _pick_interface_if_random {
    $Log->enter() if $may_enter;
    my ($pkg_or_obj, $arrayref_rulesets) = @_;
    my @rules;

    foreach my $rule (@$arrayref_rulesets) {
        my $interface = $rule->{interface};
        if (defined($interface) && $interface eq 'RANDOM') {
            unless ($pkg_or_obj->isa('NACL::C::Component::ONTAP')
                || $pkg_or_obj->isa('NACL::CS::ComponentState::ONTAP')) {
                $Log->exit() if $may_exit;
                NATE::BaseException->throw('Supplying the interface value '
                        . "as 'RANDOM' is supported only for ONTAP components"
                );
            }

            # Yes, there is SNMP support as well, but that's barely for
            # a couple of components, so it's not really worth adding it
            # to the list here (yet).
            my @interfaces     = (qw(CLI ZAPI));
            my $index          = $Global_MT_Obj->irand() % 2;
            my $deep_copy_rule = {%$rule};
            $deep_copy_rule->{interface} = $interfaces[$index];
            push @rules, $deep_copy_rule;
        } else {
            push @rules, $rule;
        }
    }

    @$arrayref_rulesets = @rules;

    $Log->exit() if $may_exit;
} ## end sub _pick_interface_if_random

1;