# $Id$

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

## @summary Utility functions commonly used by components and componentstates.
## @author dl-nacl-dev@netapp.com
## @status shared
## @pod here

package NACL::ComponentUtils;

use strict;
use warnings;
use feature qw/state/;
use Scalar::Util qw(blessed);
# use DateTime;
# use DateTime::TimeZone;
use Time::Local;

use Params::Validate qw(validate validate_pos validate_with :types);
use File::Spec::Functions;
use NATE::BaseException qw(:try);
use NATE::Exceptions::Argument;
use NACL::Exceptions::InvalidMethod qw();
use NACL::CS::ComponentState::ZapiSkip qw(is_zapi_skip);
use NACL::CS::ComponentState::ZapiArray qw(is_zapi_array);
use Tharn qw( sleep);
use NATE::Log qw(log_global);

my $Log = log_global();
my $may_enter = $Log->may_enter();
my $may_exit  = $Log->may_exit();

BEGIN {
    use Exporter qw(import);
    our @EXPORT_OK = qw(_hash_move
        _hash_copy
        _zapi_hash_copy
        _dump_one
        _optional_scalars
        AUTOLOAD
        can
        _process_options
        Dumper
        convert_to_system_time
        convert_to_unix_time
        enumerate_month
        enumerate_week
        _translate_to_obj_field_name
        get_package_name
        _can_validate_pos_spec
        _can_validation
        _verify_invocation
        get_abs_path
        _retry_logic
        _retry_spec
        _make_attribute_readonly
        _ontap_ci_validate_spec
        _convert_component_to_api
        get_real_field_name
        get_hash_of_real_field_names
        _response_exception_validate_spec
        _hash_copy_defined
        _hash_move_defined
        _is_nacl_lib_loaded
        _get_required_filter_fields
        _base_check_gui
        nate_autouse_available
    );
} ## end BEGIN

sub _optional_scalars {
    my (@names) = @_;
    return ( map { $_ => { type => SCALAR, optional => 1 } } @names );
}

# Make a shallow copy of hash "source" into hash "target" where the keys are
# renamed, where "map" contains a map from the old names to the new names.
#
# If a key in "source" doesn't exist in map "map",continue without copying that
# key. Those keys which are present in "target" hash are copied as-is unless
# they are overwritten by the map.

sub _src_target_validate_spec {
    $Log->enter() if $may_enter;
    $Log->exit() if $may_exit;
    return {
        source => { type => HASHREF },
        target => { type => HASHREF, default => {} },
    };
}

sub _hash_move_validate_spec {
    $Log->enter() if $may_enter;
    my $src_target = _src_target_validate_spec();
    $Log->exit() if $may_exit;
    return {
        %$src_target,
        map    => { type => HASHREF, default => {} },
        move   => { type => ARRAYREF, default => [] },
    };
}

sub _hash_copy_validate_spec {
    $Log->enter() if $may_enter;
    my $src_target = _src_target_validate_spec();
    $Log->exit() if $may_exit;
    return {
        %$src_target,
        map    => { type => HASHREF, default => {} },
        copy   => { type => ARRAYREF, default => [] },
    };
}

sub _hash_move {
    $Log->enter() if $may_enter;
    my ($pkg, @args) = @_;
    my %opts = validate @args, _hash_move_validate_spec();
    _internal_hash_transfer(%opts, delete_if_exists => 1);
    $Log->exit() if $may_exit;
    return $opts{target};
} ## end sub _hash_move

sub _hash_copy {
    $Log->enter() if $may_enter;
    my ($pkg, @args) = @_;
    my %opts = validate @args, _hash_copy_validate_spec();
    _internal_hash_transfer(%opts, delete_if_exists => 1);
    $Log->exit() if $may_exit;
    return $opts{target};
} ## end sub _hash_copy

sub _hash_copy_defined {
    $Log->enter() if $may_enter;
    my ($pkg, @args)  = @_;
    my %opts = validate @args, _hash_copy_validate_spec();
    _internal_hash_transfer(%opts, delete_if_defined => 1);
    $Log->exit() if $may_exit;
    return $opts{target};
}

sub _hash_move_defined {
    $Log->enter() if $may_enter;
    my ($pkg, @args)  = @_;
    my %opts = validate @args, _hash_move_validate_spec();
    _internal_hash_transfer(%opts, delete_if_defined => 1);
    $Log->exit() if $may_exit;
    return $opts{target};
} ## end sub _hash_move

# Now _hash_copy and _hash_move provide the same functionality. Both provide
# functionality to translate keys (through the 'map' option). Both also provide
# provision to transfer keys untranslated (through 'move' for _hash_move and
# through 'copy' for _hash_copy). The only difference is _hash_move deletes
# entries from the source hash, while _hash_copy leaves them untouched in
# the source hash. This method performs the translation/transfer and deletes
# conditionally and is invoked by both _hash_copy and _hash_move.
# If the 'move' option is defined, it means this was invoked by _hash_move,
# so we need to delete from source hash.
sub _internal_hash_transfer {
    my (%opts) = @_;
    my $source = $opts{source};
    my $target = $opts{target};

    my ($delete_key, $transfer_list);
    if ( exists $opts{move} ) {
        $delete_key    = 1;
        $transfer_list = 'move';
    } else {
        $delete_key    = 0;
        $transfer_list = 'copy';
    }

    my $transfer_to_target_hash = sub {
        my %opts_in_sub = validate_with(
            params => \@_,
            spec   => {
                key   => { type => SCALAR },
                value => { type => SCALAR }
            }
        );
        my $key_in_sub   = $opts_in_sub{key};
        my $value_in_sub = $opts_in_sub{value};

        my $transfer = sub {
            my $temp = $source->{$key_in_sub};
            delete $source->{$key_in_sub} if ($delete_key);
            $target->{$value_in_sub} = $temp;
        };

        if ($opts{delete_if_exists}) {
            if (exists $source->{$key_in_sub} ) {
                $transfer->();
            }
        } elsif (defined $source->{$key_in_sub}) {
            $transfer->();
        }
    };

    while (my ($key, $value) = each %{$opts{map}}) {
        $transfer_to_target_hash->(key => $key, value => $value);
    }

    foreach my $key (@{$opts{$transfer_list}}) {
        $transfer_to_target_hash->(key => $key, value => $key);
    }
} ## end sub _internal_hash_transfer

# Helper for _zapi_hash_copy, below
#   _zhc_get($x,"a") returns $x->{a}.
#   _zhc_get($x,["a"]) returns $x->{a}.
# When $x, $x->{a}, $x->{a}{b} aren't arrays (usual APISet input form):
#   _zhc_get($x,["a","b","c"]) returns $x->{a}{b}{c}
# When $x->{a} and $x->{a}[*]{b} are arrays, however (usual APISet/XML::Simple return value form):
#   _zhc_get($x,["a","b","c"]) returns $x->{a}[*]{b}[*]{c}
#       (i.e. loops over all the arrays and returns a flattened array
#       reference of all elements matching that pattern, including
#       flattening elements of {c} into the arrayref if {c} is an
#       arrayref as well)

sub _zhc_get {
    my ( $ref, $path ) = @_;
    my @path = @$path;

    # If only one element is found, we use whether @path ever
    # contained a zapi_array object to determine whether the caller
    # wanted an array reference (turn scalar answer into array with 1
    # element) or not (leave answer as scalar).
    my $want_array = 0;

    while (@path) {
        return undef if ( !defined($ref) );
        my $path_val = shift @path;
        $want_array++ if is_zapi_array($path_val);
        $ref = $ref->{$path_val};

        if ( ref($ref) && ( ref($ref) eq 'ARRAY' ) && @path ) {
            if ( @$ref > 1 ) {

                # (switch to being recursive instead of continuing to iterate)
                my $arr;
                foreach my $sub_ref (@$ref) {
                    my $inner_val = _zhc_get( $sub_ref, \@path );

                    # (The whole $arr should be undef instead of [],
                    # unless at least some child had some defined
                    # value to return, even a value like [])
                    next if !defined($inner_val);
                    $arr ||= [];
                    push @{$arr},
                        (
                        ( ref($inner_val) eq "ARRAY" )
                        ? @$inner_val
                        : $inner_val
                        );
                }
                return $arr;
            }
            $ref = $ref->[0];
        }
    } ## end while (@path)
    return ( $want_array and not( ref($ref) and ref($ref) eq 'ARRAY' ) )
        ? [$ref]
        : $ref;
} ## end sub _zhc_get

# Helper for _zapi_hash_copy, below
#   _zhc_set($x,"a",$v,$any) sets $x->{a}=$v
#   _zhc_set($x,["a"],$v,$any) sets $x->{a}=$v
#   _zhc_set($x,["a","b","c"],$v,0) sets $x->{a}{b}{c}=$v
#   _zhc_set($x,["a","b","c"],$v,1) sets $x->{a}[0]{b}[0]{c}=$v

# When an array marker object is found along the path, _zhc_set calls itself
# recursively, and behaves like so:
#   _zhc_set($x,["a",make_zapi_array("b"),"c"],0,$v) sets $x->{a}{b}[$i]{c}=$v->[$i] foreach $i
#   _zhc_set($x,["a",make_zapi_array("b"),"c"],1,$v) sets $x->{a}[0]{b}[$i]{c}=$v->[$i] foreach $i

# (Unlike _zhc_get, it also calls itself recursively when
# $has_extra_arrays is true; the while loop never loops but always
# returns in the middle in that case.  Sorry for the confusion)

sub _zhc_set {
    my ( $ref, $path, $has_extra_arrays, $value ) = @_;
    my @path = @$path;
    while ( @path > 1 ) {
        my $path_val = shift @path;
        if ( $has_extra_arrays || is_zapi_array($path_val) ) {
            if ( !defined( $ref->{$path_val} ) ) {
                $ref->{$path_val} = [];
            }
            $ref = $ref->{$path_val};
            my $value_array = (
                ( ref($value) eq "ARRAY" && is_zapi_array($path_val) )
                ? $value
                : [$value]
            );
            for ( my $i = 0; defined( $value_array->[$i] ); $i++ ) {
                if ( !defined( $ref->[$i] ) ) {
                    $ref->[$i] = {};
                }
                _zhc_set( $ref->[$i], \@path, $has_extra_arrays,
                    $value_array->[$i] );
                return;
            }
        } else {
            if ( !defined( $ref->{$path_val} ) ) {
                $ref->{$path_val} = {};
            }
            $ref = $ref->{$path_val};
        }
    }
    $ref->{ $path[0] } = $value;
} ## end sub _zhc_set

# _zapi_hash_copy

# like _hash_copy, this reads values from a source data structure and
# copies them into a target data structure, but it has more complex
# mapping rules to deal with how the values on one side or the other
# of the map may be structured very differently, because of CLI being
# flat and ZAPI being very hierarchical.

# The fields in the map are arranged so that the mapping can be
# reversed (to copy from the CLI structure to a ZAPI structure and
# also to copy from a ZAPI structure to the CLI structure) for
# situations when the ZAPI output structure is also used in the input
# or vice versa.  Sometimes these structures not identical, only
# similar, but there are extra options ('*_skip' and
# '*_has_extra_arrays') to let us continue to use just one map value
# in these cases.

# If a source field is undefined, then the corresponding target field
# will not be set (!defined is assumed to represent !exists as well)

# Options:
#   source: hashref to copy from
#
#   target: hashref to copy to (defaults to a new, empty hashref.
#     Also, the function return value is the target used)

#   map: an arrayref mapping each path in the source to a path
#     in the target.  It is in the form
#     [$source_path1=>$target_path1,$source_path2=>$target_path2,...]

#     Paths:
#       Each "path" is an arrayref of strings, which list the sequence
#       of indexes to use to access the given attribute in the source or
#       in the target.  As a special case, a string ("'foo'") is treated
#       as a one-element array ("['foo']").

#       Examples:
#         map=>["x"       => "a"      ] # sets $target{a} to $source{x}
#         map=>[["x"]     => ["a"]    ] # sets $target{a} to $source{x}
#         map=>[["x","y"] => "a"      ] # sets $target{a} to $source{x}{y}
#         map=>["x"       => ["a","b"]] # sets $target{a}{b} to $source{x}

#       Some particular objects can be used in place of these strings to
#       add additional behavior, as described below.
#
#   copy: this option may be used instead of or in addition to 'map'.
#     Contains an arrayref of paths, for those fields paths which are
#     the same in the source and destination.
#        copy => [$path1, $path2, $path3]
#     is equivalent to
#        map => [$path1 => $path1, $path2 => $path2, $path3 => $path3]

#   source_has_extra_arrays: if true, add extra array dereferences
#     between the hashes in multi-level fields, so map key ["x","y"]
#     accesses $source{x}[0]{y} instead of $source{x}{y}.
#
#   target_has_extra_arrays: if true, add extra array dereferences
#     between the hashes in multi-level fields, so map key ["a","b"]
#     accesses $target{a}[0]{b} instead of $source{a}{b}.
#
# "Zapi Skip" objects in Paths:

#   "zapi skip" objects can be constructed using a "make_zapi_skip"
#   convenience routine:
#     use NACL::CS::ComponentState::ZapiSkip qw(make_zapi_skip);

#   In place of a string, a path element may contain a "zapi skip"
#   object.  Such an object has basically the same meaning in a path
#   as the string it is constructed with, but it flags additionally
#   that this path element is required to be ignored in some
#   situations (particularly array element names, see below).  Whether
#   to ignore or not is controlled by the 'source_skips' or
#   'target_skips' options to _zapi_hash_copy.

#   Examples:
#
#     This:
#       map=>["x" => ["a", make_zapi_skip("b"), "c"]]
#     is equivalent to
#       map=>["x" => ["a", "b",                 "c"]]
#     if target_skips is false and
#       map=>["x" => ["a",                      "c"]]
#     if target_skips is true.  Similarly this:
#       map=>[["a", make_zapi_skip("b"),"c"] => "x"]
#     is equivalent to
#       map=>[["a", "b",                "c"] => "x"]
#     if source_skips is false and
#       map=>[["a",                     "c"] => "x"]
#     if source_skips is true.
#
# "Zapi Array" objects in Paths:

#   "zapi array" objects can be constructed using a "make_zapi_array"
#   convenience routine:
#     use NACL::CS::ComponentState::ZapiArray qw(make_zapi_array);

#   In place of a string, a path element may contain a "zapi array"
#   object.  Such an object has basically the same meaning in a path
#   as the string it's constructed with, but it flags that the value
#   to copy is an array whose elements are spread across many
#   different paths that fan out from this point in the path.

#   For example, if the path for a source is
#   ["a",make_zapi_array("b"),"c"], then that's saying that the
#   elements of the array value to be copied should be an array made
#   of the values in $source->{a}{b}[0]{c} through
#   $source->{a}{b}[$n]{c}.  Similarly, if that were a target path,
#   then each element of the array being copied will be assigned to
#   $target->{a}{b}[0]{c} through $target->{a}{b}[$n]{c}.

#   In the (usual) case that the source path has a zapi array object
#   and the target path doesn't, or vice versa, the leaf node of the
#   zapi-array-object-less path will be read as or assigned as the
#   whole array.  For example, with this map:
#      map => [["a",make_zapi_array("b"),"c"] => "x"]
#   all the elements of $source->{a}{b}[*]{c} will be combined into an
#   array, and then $target->{x} will be set to the entire array.

# How to use skips, arrays, and has_extra_arrays:

#   In short, use target_skips=>1 (source_skips and *_has_extra_arrays
#   remain at their default of 0) when copying from CLI-like caller
#   input to ZAPI APISet input, and then when reversing the mapping to
#   copy ZAPI response as source to a CLI-like component state, use
#   source_has_extra_arrays=>1 (target_has_extra_arrays and *_skips
#   remain at their default of 0).

#   In more detail, what options to use and why:

#     state objects (CLI layout of data) are flat and arrays only fan
#     out at the leaf, and so one can get/set an array as though it
#     were a scalar (get/set the leaf arrayref as a single value), and
#     so when this is used as a source then source_has_extra_arrays
#     and source_skips need never be set, and when used as a target
#     the corresponding target options needn't be set, and the paths
#     for this source/target will just be the simple name of the
#     attribute.

#     ZAPI request data (APISet method options) are goverened by
#     typedef information: perl arrays only need be passed in for data
#     that is actually an array instead of a typedef, so
#     target_has_extra_arrays should not be set when the target is of
#     this type.  For data that is an array, the names of the XML
#     elements that delineate each array element must not appear in
#     the perl representation of the data (the APISet will use typedef
#     information to add them in) and so those array element names
#     will need to be marked with make_zapi_skip() in the map, and
#     target_skips should be set when the target is of this type.
#     (When this type of data is a source, then
#     source_has_extra_arrays should be 0 similarly and source_skips
#     should be true, similarly, but this mode is under-tested since
#     test code generally has no need to *read* ZAPI *requests*)

#     ZAPI response data (APISet parsed output) is generally not
#     goverened by typedef information.  Since it's not known which
#     elements may contain repeated elements or which elements
#     represent arrays, every element is generally represented by a
#     hash of arrays (hash key is element name, array is of each child
#     node with that element name that appeared), and so when the
#     source is a ZAPI response then source_has_extra_arrays" should
#     be set and source_skips should be 0.  (Similarly, when a ZAPI
#     response is the target, target_has_extra_arrays would be set and
#     target_skips would be 0, but this mode is under-tested since
#     test code generally has no need to *write* ZAPI *responses*).

#  What paths to use in 'map':

#    A ZAPI scalar, perhaps hierarcically nested inside a few
#    typedefs/structs (just for structure, not because any of them is
#    an array) usually needs no skips and no arrays:

#      map=>[cli_field => ['container1','container2','zapi_field']]

#    However, sometimes one of the paths to the zapi_field must be
#    skipped on input but not on output, particularly if it is
#    the name of the type of the preceeding structure member:

#      map=>[cli_field => [
#                'container1',
#                make_zapi_skip('typedef_of_container1'),
#                'zapi_field'
#            ]]

#    A ZAPI array tends to contain an array object followed by a skip
#    object:

#      map=>[cli_field => [
#                'foo-widget-attributes',
#                make_zapi_array('widgets'),
#                make_zapi_skip('widget')
#            ]]

#      map=>[plexes => [
#                'aggr-raid-attributes',
#                make_zapi_array('plexes'),
#                make_zaip_skip('plex-attributes'),
#                'plex-name',
#            ]]

# The special case of ZAPI arrays of arrays:
#
#  In the worst case, a ZAPI structure may contain an array of arrays:
#
#      map => [ "raidgroups" => [
#                   'aggr-raid-attributes',
#                   make_zapi_array('plexes'),
#                   make_zapi_skip('plex-attributes'),
#                   make_zapi_array('raidgroups'),
#                   make_zapi_skip('raidgroup-attributes'),
#                   'raidgroup-name'
#              ]]

#  When a copy is made with the above map (CLI input to ZAPI input),
#  the desired behavior is ambiguous (how do you copy from a
#  1-dimentional array to a 2-dimentional array?) and this routine
#  resolves the ambiguity by having the fanout be entirely closest to
#  the top (the one dimensional array is copied to the two dimensional
#  array by having the second dimension be 1).  In this example, a
#  ZAPI input (such as a 'query') will have one target plex per source
#  raid group, and then only one target raidgroup per target plex
#  (which may or may not be the desired behavior).  When a copy is
#  made using the reverse of the above map, the arrays at all levels
#  will be iterated over.  So, in this example, the CLI (storage
#  aggregate component state) raidgroups array will be a flat array of
#  all the raidgroups in all the plexes (which happens to be the
#  desired behavior)

sub _zapi_hash_copy {
    my $pkg_or_obj = shift;
    my %opts       = validate(
        @_,
        {   source                  => { type => HASHREF },
            source_has_extra_arrays => { type => BOOLEAN, default => 0 },
            source_skips            => { type => BOOLEAN, default => 0 },
            target                  => { type => HASHREF, default => {} },
            target_has_extra_arrays => { type => BOOLEAN, default => 0 },
            target_skips            => { type => BOOLEAN, default => 0 },
            map                     => { type => ARRAYREF, default => [] },
            copy                    => { type => ARRAYREF, default => [] },
        }
    );
    if ( !@{ $opts{map} } && !@{ $opts{copy} } ) {
        NATE::Exceptions::Argument->throw( "Either of 'map' or 'copy'"
                . "should have been provided as argument to '_zapi_hash_copy()' "
                . 'but neither were' );
    }
    my @map = @{ $opts{map} };

    # copy => [ qw(a b) ] is equivalent to map => [ a => 'a', b => 'b' ]
    # For each element in copy, add an entry in map which maps the element
    # to itself
    foreach ( @{ $opts{copy} } ) {
        push @map, ( $_ => $_ );
    }

    my $target = $opts{target};
    while (@map) {
        my $src_key = shift @map;
        $src_key = ( ( ref($src_key) eq "ARRAY" ) ? $src_key : [$src_key] );
        if ( $opts{source_skips} ) {
            $src_key = [ grep { !is_zapi_skip($_) } @$src_key ];
        }
        my $src_val = _zhc_get( $opts{source}, $src_key );
        my $target_key = shift @map;
        $target_key = (
            ( ref($target_key) eq "ARRAY" ) ? $target_key : [$target_key] );
        if ( $opts{target_skips} ) {
            $target_key = [ grep { !is_zapi_skip($_) } @$target_key ];
        }
        if ( defined($src_val) ) {
            _zhc_set( $target, $target_key, $opts{target_has_extra_arrays},
                $src_val );
        }
    } ## end while (@map)
    return $target;
} ## end sub _zapi_hash_copy

sub _dump_one {
    my ($value) = @_;
    require Data::Dumper;
    local $Data::Dumper::Purity   = 1;
    local $Data::Dumper::Deepcopy = 1;
    local $Data::Dumper::Terse    = 1;
    local $Data::Dumper::Indent   = 0;
    return Data::Dumper::Dumper($value);
} ## end sub _dump_one

# If one of the methods called on a component state has hyphens in its
# name, call the equivalent method that has underscores in its name.
# Callers who want to access an individual component state field will
# use underscore form, and that form of the accessor methods will be
# supplied by Class::MethodMaker:
#   my $a_b_c = $state->a_b_c();
# while callers who want to assign a component state field based on
# one of their parameters (which may have hyphen separators) can
# indirectly call the method with a hyphenated name:
#  foreach my $param ("a-b-c", "d-e-f") {
#    my $value = $opts{$param};
#    $state->$param($value);
#  }
# and that form of the accessor methods will be supplied by this
# AUTOLOAD.

sub AUTOLOAD {
    $Log->enter() if $may_enter;
    my $pkg_or_obj = shift;
    our $AUTOLOAD;
    my $method = $AUTOLOAD;
    if ( $AUTOLOAD =~ /DESTROY/ ) {
        return;
    }
    $method =~ s/.*:://;

    my ( $package, $meth ) = ( $AUTOLOAD =~ /(?:(.*)::)?(.*)/ );
    if ( !$pkg_or_obj->isa($package) ) {

        # This is a function, not a method
        $Log->exit() if $may_exit;
        NATE::Exceptions::Argument->throw( "The function '$method' is "
                . "not defined (maybe '$method' needs to be imported "
                . 'from some other package?)' );
    }

    my $code;
    my $error;
    if ( $code = $pkg_or_obj->can( $method, \$error, @_ ) ) {

        # First, modify the class that we were invoked from so that it
        # implements the "real" accessor method directly itself, so
        # that future calls on this class and method skip over going
        # through this AUTOLOAD again.  We can modify the symbol table
        # of the class to point at the other class's subroutine,
        # rather than define a new subroutine (same thing that
        # "import" does).

        # Symbolic references (${"string"}, or *{$AUTOLOAD} in this
        # case) aren't "wrong" per se, but they're nasty if used by
        # accident, so "use strict" disables them by default.

        no strict 'refs';
        *{$AUTOLOAD} = $code;
        use strict 'refs';
        $Log->exit() if $may_exit;
        return $code->( $pkg_or_obj, @_ );
    } else {
        my $ref        = $pkg_or_obj->get_package_name();
        my $full_error = "Method '$method' not defined on package '$ref'. ";
        if ($error) {
            $full_error .= 'The method could not be resolved in the '
                . "following additional places:\n";
            $full_error .= $error;
        }
        $Log->exit() if $may_exit;
        NACL::Exceptions::InvalidMethod->throw(
            NATE::Util::indent( 4, "$full_error\n" ),
            method => $method,
        );
    }
} ## end sub AUTOLOAD

# When checking to see if this component state has the given method,
# return the code-reference if the method can be resolved to an existing
# accessor method, else return undef.

sub can {
    $Log->enter() if $may_enter;
    my $pkg_or_obj = shift;
    my ( $method, $error_ptr ) = $pkg_or_obj->_can_validation(@_);
    $method = $pkg_or_obj->_translate_to_obj_field_name($method);
    my $code;
    if ( $code = $pkg_or_obj->SUPER::can($method) ) {
        $Log->exit() if $may_exit;
        return $code;
    } else {
        $Log->exit() if $may_exit;
        return undef;
    }
}

# The validation spec for the overridden can() implementations
# It is an ordered list of method name and an error pointer (optional,
# hence defaulted to a pointer to a dummy variable)
# can() implementations probably won't need to use this directly but would
# go through _can_validation
sub _can_validate_pos_spec {
    $Log->enter() if $may_enter;
    my $dummy;
    $Log->exit() if $may_exit;
    return (
        { type => SCALAR },
        { type => SCALARREF, default => \$dummy },
        (0) x (1000)
    );    # (0) x ( 1000 ) is added to the spec for
          # passing other optional parameters to can
}

# Validate the options sent to can and return the array of validated options
sub _can_validation {
    $Log->enter() if $may_enter;
    my $pkg_or_obj = shift;
    my @opts = validate_pos @_, $pkg_or_obj->_can_validate_pos_spec();
    $Log->exit() if $may_exit;
    return @opts;
}

#
# Returns the spec for ONTAP command interface
#
sub _ontap_ci_validate_spec {
    return { isa => 'NACL::C::CommandInterface::ONTAP', type => OBJECT };
}

=head1 _process_options

    sub call_on_apiset {
        my $pkg_or_obj = shift;
        ...
        my $apiset = $command_interface->apiset(%apiset_opts);
        if ( $pkg_or_obj->isa("NACL::C::Component") ) {
            $pkg_or_obj->_process_options( options => \%opts );
        } else {
            $pkg_or_obj->_process_options( options => $opts{filter} );
        }
        ...
    }

This method provides support for options of component methods (as well as filter
fields) being passed component objects (in addition to the default of being
passed strings). This allows for code such as this to be written

    my $node    = NACL::C::Node->find();
    my $vserver = NACL::C::Vserver->find(command_interface => $node);
    my $vol     = NACL::C::Volume->create(
        command_interface => $node,
        vserver           => $vserver,
        ...
    );
This method determines the string form of the component object passed in
(for example for a vserver object it would be $vserver->vserver()).

This method is invoked to perform the translation on options to component
methods as well as to the filter passed into C<find> (or into the
ComponentState's C<fetch>). It also peforms this translation on options
which is an arrayref of component objects.

=cut

sub _process_options {
    $Log->enter() if $may_enter;
    my ( $pkg_or_obj, %opts ) = @_;
    my $options = $opts{options};
    use Scalar::Util qw(blessed);
    require Data::Dumper;
    my ( $key, $value );

    my $sub = sub {
        my $obj = shift;
        if ( !blessed $obj) {
            return $obj;
        } else {
            if ( $obj->isa("NACL::C::Component") ) {
                if ( $obj->NACL::C::Component::can($key) ) {
                    $Log->debug('Returning $obj->$key');
                    return $obj->$key();
                } elsif ( $obj->NACL::C::Component::can('name_attribute') ) {

                   # name_attribute would return the attribute which
                   # gives information about the name of the object
                   # Eg: for snapshot object, 'snapshot' is the name attribute
                    my $attr = $obj->name_attribute();
                    $Log->debug( 'Returning $obj->'
                            . $attr
                            . ' selected by name_attribute' );
                    return $obj->$attr();
                } else {
                    $Log->debug( "Could not find primary key '$key'. "
                            . "Searching for primary keys for which '$key' is a "
                            . "partial match" );
                    my @primary_keys = $obj->get_primary_keys();
                    $Log->debug( "Primary keys are:\n"
                            . Data::Dumper::Dumper( \@primary_keys ) );
                    my @partial_matches = grep { $key =~ /$_/ } @primary_keys;
                    if (@partial_matches) {
                        $Log->debug( "Partial matches are:\n"
                                . Data::Dumper::Dumper( \@partial_matches ) );
                        my $method = $partial_matches[0];
                        $Log->warn( "You have passed in an object of type"
                                . ref($obj)
                                . " as the value "
                                . "for the option '$key' and components has chosen "
                                . "the attribute '$method' using its partial "
                                . "match logic to stringify the object.\nNote that "
                                . "the attribute selected by the partial match logic"
                                . " would not result in the same match every time\n"
                                . "and so there is a possibility that your test "
                                . "might fail at certain times.\n"
                                . "Please raise a burt with type as NACL and subtype"
                                . " as nacl_core if you believe that the object and "
                                . "key pair is a valid combination" );
                        return $obj->$method();
                    } else {

                       # Earlier the previous elsif block was doing grep
                       # wrongly that all primary keys matched and the value
                       # of the first attribute is always returned back. There
                       # are some components which have overridden
                       # _common_validate_with (Eg: NACL::C::VolumeQtree)
                       # which inturn invokes _process_options and passes
                       # job_component to this method. Now that the incorrect
                       # grep logic is fixed, execution will reach this
                       # 'else' block. So we should no longer throw an
                       # exception, rather return back the same object and
                       # leave it to the caller to act on this.
                        $Log->debug( "No primary keys found "
                                . "which partially match '$key'" );
                        $Log->exit() if $may_exit;
                        return $obj;
                    }
                } ## end else [ if ( $obj->can($key) )]
            } else {
                return $obj;
            }
        } ## end else [ if ( !blessed $obj) ]
    };

    while ( ( $key, $value ) = each %$options ) {
        if ( ref($value) eq "ARRAY" ) {
            my @arr;
            foreach (@$value) {
                push @arr, $sub->($_);
            }
            @$value = @arr;
        } else {
            $options->{$key} = $sub->($value);
        }
    } ## end while ( ( $key, $value ) ...)
    $Log->exit() if $may_exit;
} ## end sub _process_options

# A wrapper round Data::Dumper::Dumper which sets Maxdepth to 1
# This is necessary to handle the issues outlined in burt 485645
# Meant for use only in front-end methods where the arguments being sent
# to it are dumped. All other dumping of data structures should use
# Data::Dumper::Dumper instead.
sub Dumper {
    require Data::Dumper;
    local $Data::Dumper::Maxdepth = 2;
    return Data::Dumper::Dumper(@_);
}

# This method discovers the timezone of the service (filer)
# Inputs: command_interface, interface
# Output: Timezone
sub _find_time_zone {
    $Log->enter() if $may_enter;
    my %opts = validate @_,
        {
        command_interface => _ontap_ci_validate_spec(),
        interface         => { type => SCALAR, optional => 1 },
        };

    my $ci     = $opts{command_interface};
    my %others = ();
    if ( $opts{interface} ) {
        $others{apiset_should} = { interface => $opts{interface} };
    }
    my $zone = $ci->get_timezone(%others);
    $Log->exit() if $may_exit;
    return $zone;
}

# This method converts the system time format in the specified
# timezone to unix time format.
# Inputs: year, month, day, hour, minute, second, command_interface,
#         interface ( used as preference in apiset_should)
# month should be passed as a number, 1 represets jan and 12 represents Dec
# Output : unix time
sub convert_to_unix_time {
    $Log->enter() if $may_enter;
    my ( $pkg, @args ) = @_;
    my %args = validate @args,
        {
        year              => { type => SCALAR },
        month             => { type => SCALAR },
        day               => { type => SCALAR },
        hour              => { type => SCALAR },
        minute            => { type => SCALAR },
        second            => { type => SCALAR },
        command_interface => {
            isa      => "NACL::C::CommandInterface::ONTAP",
            optional => 1,
            type     => OBJECT
        },
        timezone  => { type => SCALAR, optional => 1 },
        interface => { type => SCALAR },
        };
    unless ( $args{command_interface} || $args{timezone} ) {
        $Log->exit() if $may_exit;
        NATE::Exceptions::Argument->throw( 'Either of command_interface '
                . 'or timezone option should be specified' );
    }
    require DateTime;
    require DateTime::TimeZone;
    my $dt   = DateTime->now;
    my $tz   = DateTime::TimeZone->new( name => "local" );
    my $zone = delete $args{timezone};
    unless ($zone) {
        $zone = _find_time_zone(
            command_interface => delete $args{command_interface},
            interface         => delete $args{interface}
        );
    }
    my $time = DateTime->new(
        year      => $args{year},
        month     => $args{month},
        day       => $args{day},
        hour      => $args{hour},
        minute    => $args{minute},
        second    => $args{second},
        time_zone => $zone,
    );
    $time->set_time_zone( $tz->name );
    my @time = split( /-|T|:/, $time );

    # timelocal expects the month to begin from 0.
    $time[1] -= 1;
    my $new_val = timelocal( reverse(@time) );
    $Log->debug( "Original system time: "
            . Dumper( \%args )
            . "converted unix-time value: $new_val" );
    $Log->exit() if $may_exit;
    return $new_val;
}

# This method converts the unix time to system time format in the
# requested time zone.
# Inputs: unixtime, command_interface,
#         interface ( used as preference in apiset_should)
# Output: A hash reference whose keys are year, month, day, hour, minute,
#         second, day_of_week
sub convert_to_system_time {
    $Log->enter() if $may_enter;
    my ( $pkg, @args ) = @_;
    my %args = validate @args,
        {
        unixtime          => { type => SCALAR },
        command_interface => {
            isa      => "NACL::C::CommandInterface::ONTAP",
            optional => 1,
            type     => OBJECT
        },
        timezone  => { type => SCALAR, optional => 1 },
        interface => { type => SCALAR, optional => 1 },
        };
    unless ( $args{command_interface} || $args{timezone} ) {
        $Log->exit() if $may_exit;
        NATE::Exceptions::Argument->throw( 'Either of command_interface '
                . 'or timezone option should be specified' );
    }

    my $unixtime = $args{'unixtime'};

    unless ( $unixtime =~ /^\d+$/ ) {

        # The input is not in unix time format.
        NATE::BaseException->throw("Invalid unix time specified");
    }

    require DateTime;
    require DateTime::TimeZone;

    my @test = localtime($unixtime);
    $test[4] += 1;
    $test[5] += 1900;
    my $dt   = DateTime->now;
    my $tz   = DateTime::TimeZone->new( name => "local" );
    my $zone = delete $args{timezone};
    unless ($zone) {
        $zone = _find_time_zone(
            command_interface => delete $args{command_interface},
            interface         => delete $args{interface}
        );
    }
    my $time = DateTime->new(
        year      => $test[5],
        month     => $test[4],
        day       => $test[3],
        hour      => $test[2],
        minute    => $test[1],
        second    => $test[0],
        time_zone => $tz->name,
    );
    $time->set_time_zone($zone);
    my $day_of_week = $time->day_of_week();
    my @time        = split( /-|T|:/, $time );
    my %hash        = (
        year        => $time[0],
        month       => $time[1],
        day         => $time[2],
        hour        => $time[3],
        minute      => $time[4],
        second      => $time[5],
        day_of_week => $day_of_week
    );
    $Log->debug( "Specified unix time: $unixtime\n"
            . "Converted system time:"
            . Dumper( \%hash ) );

    $Log->exit;
    return \%hash;
}

# This method returns the enumerated value for the month names
# if 'reverse' => 1 else it will do the viceversa.
# Inputs - month (can be the name of the month or the numerical equivalent),
#          reverse (decides the translation direction)
# outputs - Translated value

sub enumerate_month {
    $Log->enter() if $may_enter;
    my $pkg  = shift @_;
    my %args = validate @_,
        {
        'reverse' => { type => SCALAR, optional => 1, default => 0 },
        month     => { type => SCALAR },
        };
    my %month = (
        'Jan' => 1,
        'Feb' => 2,
        'Mar' => 3,
        'Apr' => 4,
        'May' => 5,
        'Jun' => 6,
        'Jul' => 7,
        'Aug' => 8,
        'Sep' => 9,
        'Oct' => 10,
        'Nov' => 11,
        'Dec' => 12
    );
    my $month = $args{month};
    my $val;
    if ( $args{reverse} ) {

        # get the verbal form
        my %rev_month = reverse %month;

        # strip out the leading zeros
        $month =~ s/^0+//;
        $val = $rev_month{$month};
    } else {

        # get enumerated form
        grep { $val = $month{$_} if ( $month =~ /^$_/i ) } keys %month;
    }

    NATE::Exceptions::Argument->throw( "Invalid month specified: " . $month )
        unless ( defined $val );
    $Log->exit;
    return $val;
}

# This method returns the enumerated value for the days of the week
# if 'reverse' => 1 else it will do the viceversa.
# Inputs - wday (can be the name of the week day or the numerical equivalent),
#          reverse (decides the translation direction)
# outputs - Translated value

sub enumerate_week {
    $Log->enter() if $may_enter;
    my $pkg  = shift @_;
    my %args = validate @_,
        {
        'reverse' => { type => SCALAR, optional => 1, default => 0 },
        wday      => { type => SCALAR },
        };
    my %week = (
        'Mon' => 1,
        'Tue' => 2,
        'Wed' => 3,
        'Thu' => 4,
        'Fri' => 5,
        'Sat' => 6,
        'Sun' => 7
    );
    my $wday = $args{wday};
    my $val;
    if ( $args{reverse} ) {

        # get the verbal form
        my %rev_week = reverse %week;

        # strip out the leading zeros
        $wday =~ s/^0+//;
        $val = $rev_week{$wday};
    } else {

        # get enumerated form
        grep { $val = $week{$_} if ( $wday =~ /^$_/i ) } keys %week;
    }

    NATE::Exceptions::Argument->throw( "Invalid day specified: " . $wday )
        unless ( defined $val );
    $Log->exit;
    return $val;

}

=head2 _translate_to_obj_field_name

    my $accessor_method = $pkg_or_obj->_translate_to_obj_field_name($field_name);

Translate from the field name as returned by the product to what the
accessor is named. The accessor name might not exactly match the field
name due to perl's limitation with subroutine names (does not allow hyphens,
dots or for the names to begin with digits). The conventions we have are:
1: All hyphenated keys have hyphens converted to underscores
2. All keys with dots in them will have the dots converted to underscores
3. All keys beginning with a digit will have an underscore prefixed

So, the field "v4.0" will have an accessor method "v4_0", and the field
"7d-change-vols" will have the accessor method "_7d_change_vols".

This is called by can() to allow all of the below to work (fields with
hyphens, fields with dots, fields beginning with digits):
foreach my $field (qw(percent-used v4.0 7d-change-vols)) {
        $cs->$field($val);
    }

=cut

sub _translate_to_obj_field_name {
    $Log->enter() if $may_enter;
    my ( $pkg_or_obj, $field ) = @_;

    # Convert all hyphens to underscores
    $field =~ s/-/_/g;

    # Translate only if necessary
    if ( $field =~ /^\d|[.]/ ) {
        $Log->debug("Original field name: $field");

        # Prefix with an underscore if it begins with a digit
        if ( $field =~ /^\d/ ) {
            $field = "_$field";
        }

        # Fields with . in them will also cause perl to complain.
        # We convert all . to _
        $field =~ s/\./_/g;

        $Log->debug("Translated field name: $field");
    }

    $Log->exit() if $may_exit;
    return $field;
}

=head2 get_package_name

    # Assuming $volume_obj is of type "NACL::C::Volume"
    my $pkg = $volume_obj->get_package_name(); # $pkg = "NACL::C::Volume"

    my $pkg = NACL::C::Volume->get_package_name(); # $pkg = "NACL::C::Volume"
Returns the package name for the package or object with which the method
was invoked.

=cut

sub get_package_name {
    $Log->enter() if $may_enter;
    my $pkg_or_obj = shift;
    my $pkg = ref $pkg_or_obj ? ref $pkg_or_obj : $pkg_or_obj;
    $Log->debug("Package name is $pkg");
    $Log->exit() if $may_exit;
    return $pkg;
}

sub _verify_invocation {
    $Log->enter() if $may_enter;
    my $pkg_or_obj = shift;
    my %opts       = validate(
        @_,
        {   style => {
                type      => SCALAR,
                callbacks => {
                    "Internal error: value of 'style' should be 'instance_only' or 'static_only'"
                        => sub { $_[0] =~ /(instance_only)|(static_only)/i }
                }
            }
        }
    );
    my $method = ( caller(1) )[3];
    if ( $opts{style} eq 'instance_only' ) {
        unless ( ref($pkg_or_obj) ) {
            $Log->exit() if $may_exit;
            NATE::BaseException->throw(
                      "${method} of '${pkg_or_obj}' can only be "
                    . "invoked as an instance method" );
        }
    } else {
        if ( ref($pkg_or_obj) ) {
            $Log->exit() if $may_exit;
            NATE::BaseException->throw(
                      "${method} of '${pkg_or_obj}' can only be "
                    . "invoked as a static method" );
        }
    }

    $Log->exit() if $may_exit;
}

=head2 get_abs_path
  # $path would be mount_point/subdir1/subdir2/filename for Unix like clients
  # $path would be mount_point\subdir1\subdir2\filename for Windows clients

  my $path =  NACL::ComponentUtils->get_abs_path(
                $mount_object, 'subdir1', 'subdir2', 'filename'
               );
  # There are no subdirectories given. So it would just return mount point
  # Eg: $path would be '/dir/mount' for Unix like clients, "C:/" or
  # "\\server\dir" for Windows clients
  my $path =  NACL::ComponentUtils->get_abs_path($mount_object);
(Class or Instance method)
This method helps you to obtain the absolute path given the
mount object (NACL::STask|C::Client::Mount) and/or the names of subdirectories
and file. This method handles differences in path format for
Windows and Unix like clients and thus helps to write client agnostic
scripts. Returns the absolute path.

=over

=item Options

=over

=item C<< @names_of_subdirs_and/or_file >>

(Required)
An array of mount object (NACL::STask|C::Client::Mount)
object followed by optionally a list of subdirectory names and file name.

=back

=back

=cut

sub get_abs_path {
    $Log->enter() if $may_enter;
    my ( $pkg_or_obj, @paths ) = @_;
    if ( !scalar(@paths) ) {
        $Log->exit() if $may_exit;
        NATE::Exceptions::Argument->throw( "Missing the input list of "
                . "directory or file names from which absolute path can be "
                . "constructed" );
    }
    my $get_mount_point = sub {
        my $mt = shift;
        if ( $mt->isa('NACL::C::Client::Mount') ) {
            return $mt->mount_point();
        } else {
            $Log->exit() if $may_exit;
            NATE::BaseException->throw( "Objects of type "
                    . ref($mt)
                    . " cannot be specified in 'paths' input "
                    . "of build_path()" );
        }
    };
    @paths = map { ref($_) ? $get_mount_point->($_) : $_ } @paths;
    my $path = File::Spec::Functions::catfile(@paths);
    $Log->debug("The constructed path is $path");
    $Log->exit() if $may_exit;
    return $path;
}

# The logic of retrying is laid out as a separate method for use by both C
# and CS of Job related components. This is a workaround for the product
# burt 517892

sub _retry_logic {
    $Log->enter() if $may_enter;
    my $pkg_or_obj = shift @_;
    my %args       = validate_with(
        params => \@_,
        spec   => {
            method         => { type => SCALAR },
            args           => { type => HASHREF, default => {} },
            exception_type => { type => SCALAR },
            retry => $pkg_or_obj->_retry_spec(),
        },
    );

    my $method         = $args{method};
    my %opts           = %{ $args{args} };
    my $exception_type = $args{exception_type};

    # The workaround is to try $opts{nacl_retry_count} times with 1 second
    # delay before we bail out.
    my $retry      = $args{retry};
    my $is_success = 0;
    my (@response, $done);

    # Check if this is a method which takes job id for 'id' parameter
    # and not UUID and retries should be performed only for the former.
    # Also if the method is invoked without job id parameter (would
    # there be a case like that as it's a pri key? yeah may be, this
    # would help for the CS fetch method), then also this
    # workaround code shouldn't be effected.
    my $jobid = _get_job_id( $pkg_or_obj, %opts );
    unless ( defined $jobid && ( $jobid !~ /-/ ) ) {

        # If the value sent to 'id' has '-' in it, then it represents
        # UUID or an invalid job ID. So don't retry in those cases even
        # if the user had asked us to do.
        $Log->debug("Retries are not required");
        $retry = 0;
    }

    # We should retry $retry no.of times apart from the actual first time
    # invocation.
    my $tries_left  = $retry + 1;
    my $hit_failure = 0;
    $Log->debug("Method $method will be invoked $tries_left times");

    while (1) {
        try {
            @response = $pkg_or_obj->_invoke( method => $method, %opts );
            $done = 1;
            if ($hit_failure) {

                # product failure is hit and the command had succeeded after
                # some retries.
                my $obj_or_pkg
                    = ( ref $pkg_or_obj )
                    ? "object of type " . ref $pkg_or_obj
                    : "package $pkg_or_obj";
                $Log->warn( "The method '$method' on the $obj_or_pkg "
                        . "has succeeded after retrying for $retry times with a "
                        . "1 sec delay between every retry. You might be hitting"
                        . " the product burt 517892 and the NACL library has "
                        . "provided the workaround to overcome the timing issue "
                        . "discussed in the burt. It is recommended to "
                        . 'update the burt with details on your run.'
                );

            }
        }
        catch $exception_type with {
            my $exception = shift;
            $hit_failure = 1;
            $tries_left--;

            # Burt 925773
            # If job already moved to history table, then the retry logic
            # results in waiting unnecessarily. Here we check if the job
            # has been moved to the history table and if so, break out
            # immediately.
            # This is applicable only for NACL::C::Job/NACL::CS:Job
            # (it would not make sense for a JobHistory->fetch call to
            # again check if it's in the history table)
            if (_isa_job($pkg_or_obj)) {
                require NACL::C::JobHistory;
                my %common_opts_ci;
                $pkg_or_obj->_copy_common_component_params_with_ci(
                    source => \%opts,
                    target => \%common_opts_ci,
                );
                $Log->comment('Checking if entry is present in job-history '
                    . 'table. If present, then we can disable the retry '
                    . 'added for burt 517892'
                );
                my $present_in_history = NACL::C::JobHistory->find(
                    %common_opts_ci,
                    filter           => {id => $jobid},
                    allow_empty      => 1,
                    nacl_retry_count => 0,
                );
                if ($present_in_history) {
                    $Log->exit() if $may_exit;
                    $exception->throw();
                }
            }
            if ($tries_left) {
                $Log->comment('Snooze for a second and retry (workaround for '
                    . 'burt 517892)');
                Tharn::snooze(1);
            } else {
                $Log->exit() if $may_exit;
                $exception->throw();
            }
        };
        last if $done;
    }

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

sub _retry_spec {
    $Log->enter() if $may_enter;
    $Log->exit() if $may_exit;
    return { type => SCALAR, default => 3 };
}

# This method handles the differences between C and CS input arguments and
# returns back the job id
sub _get_job_id {
    $Log->enter() if $may_enter;
    my ( $pkg_or_obj, %opts ) = @_;
    my $value;
    if ( $pkg_or_obj->isa('NACL::CS::ComponentState::ONTAP') ) {
        $value = $opts{filter}->{id};
    } else {
        $value = $opts{id};
    }
    $Log->exit() if $may_exit;
    return $value;
}

# Check if this is a NACL::C/CS::Job package or object
sub _isa_job {
    $Log->enter() if $may_enter;
    my $pkg_or_obj = $_[0];
    my $isa_job;
    if ($pkg_or_obj->isa('NACL::C::Job') || $pkg_or_obj->isa('NACL::CS::Job')) {
        $isa_job = 1;
    }
    $Log->exit() if $may_exit;
    return $isa_job;
}

sub _make_attribute_readonly {
    return ( -store_cb => \&_throw_readonly_exception );
}

sub _throw_readonly_exception {
    $Log->enter() if $may_enter;
    my $self      = $_[0];
    my $attribute = $_[2];
    my $pkg       = $self->get_package_name();
    $Log->exit() if $may_exit;
    NATE::BaseException->throw( "The attribute '$attribute' of package "
            . "'$pkg' is read-only, but an attempt was made to set a value" );
}

=head2 get_hash_of_real_field_names

    use NACL::ComponentUtils qw(get_hash_of_real_field_names
    get_real_field_name);
    ...

    my $attributes_hashref = NACL::CS::VserverNfs->get_attributes();
    my @attributes         = keys %$attribute_hashref;
    my %hash = get_hash_of_real_field_names(
        command_interface => $ci,
        api               => 'vserver_nfs_show',
        attributes        => \@attributes
    );

                          OR

    # Uses the package name to determine the API to be invoked
    my $attributes_hashref = NACL::CS::VserverNfs->get_attributes();
    my @attributes         = keys %$attribute_hashref;
    my %hash = get_hash_of_real_field_names(
        command_interface => $ci,
        package           => 'NACL::CS::VserverNfs',
        attributes        => \@attributes
    );

                          OR

    # Uses a possibly in-exact algorithm (explained below)
    my $attributes_hashref = NACL::CS::VserverNfs->get_attributes();
    my @attributes         = keys %$attribute_hashref;
    my %hash = get_hash_of_real_field_names(attributes => \@attributes);

Due to limitations imposed on the names of subroutines in Perl, the attributes
of the ComponentState packages will not necessarily match the name of the
field as returned in the relevant "show" command. Given a field name, the
name of the attribute of the CS package will have:

* All hyphens converted to underscores

* All dots converted to underscores (example: field name
"v4.0-read-delegation" results in the attribute being named
"v4_0_read_delegation"

* Any fields with leading digits will result in the attribute name
having a leading underscore. (example: field name "7d-change-vols"
will result in the attribute being named "_7d_change_vols")

This method performs the reverse translation (i.e. from CS attribute name
to the field name as it was originally returned by the product). For this
purpose it needs to lookup the CDEF, which is why the C<command_interface>
(the appropriate CDEF is retrieved from it) and C<api> are accepted as
arguments.

In the absence of a CDEF file (or in the case where the command_interface
is a 7Mode host) the following algorithm is performed:

* Leading underscores are stripped (this would occur for cases where
the "real" field name starts with a digit)

* Underscores are converted to hyphens. However, for cases where the
underscore is between two digits, then it is converted to a dot.
("v4_0_read_delegation" should translate to "v4.0-read-delegation", not
to "v4-0-read-delegation")

Note that this algorithm is not full-proof, whereas the lookup of the CDEF
is, which is why it is suggested that wherever possible the
C<command_interface> and C<api> arguments are supplied.

The return value of this method is a hash, with a mapping between
the attributes of the CS package and the field name as returned by the
product. Here's an example return hash:

#      CS Attribute => Real field name
$VAR1 = {
        'access' => 'access',
        'cache_ejukebox' => 'cache-ejukebox',
        'chown_mode' => 'chown-mode',
        'default_win_group' => 'default-win-group',
        'default_win_user' => 'default-win-user',
        'enable_ejukebox' => 'enable-ejukebox',
        'force_spinnp_readdir' => 'force-spinnp-readdir',
        'ipv6' => 'ipv6',
        'is_drained' => 'is-drained',
        'is_enabled' => 'is-enabled',
        'mount_rootonly' => 'mount-rootonly',
        'ntfs_unix_security_ops' => 'ntfs-unix-security-ops',
        'rpcsec_ctx_high' => 'rpcsec-ctx-high',
        'rpcsec_ctx_idle' => 'rpcsec-ctx-idle',
        'rquota' => 'rquota',
        'spinauth' => 'spinauth',
        'tcp' => 'tcp',
        'tcp_max_xfer_size' => 'tcp-max-xfer-size',
        'trace_enabled' => 'trace-enabled',
        'trigger' => 'trigger',
        'udp' => 'udp',
        'udp_max_xfer_size' => 'udp-max-xfer-size',
        'v2' => 'v2',
        'v3' => 'v3',
        'v3_connection_drop' => 'v3-connection-drop',
        'v3_fsid_change' => 'v3-fsid-change',
        'v3_require_read_attributes' => 'v3-require-read-attributes',
        'v3_tcp_max_read_size' => 'v3-tcp-max-read-size',
        'v3_tcp_max_write_size' => 'v3-tcp-max-write-size',
        'v4' => 'v4',
        'v4_0' => 'v4.0',
        'v4_0_acl' => 'v4.0-acl',
        'v4_0_migration' => 'v4.0-migration',
        'v4_0_read_delegation' => 'v4.0-read-delegation',
        'v4_0_referrals' => 'v4.0-referrals',
        'v4_0_req_open_confirm' => 'v4.0-req-open-confirm',
        'v4_0_write_delegation' => 'v4.0-write-delegation',
        'v4_1' => 'v4.1',
        'v4_1_acl' => 'v4.1-acl',
        'v4_1_implementation_date' => 'v4.1-implementation-date',
        'v4_1_implementation_domain' => 'v4.1-implementation-domain',
        'v4_1_implementation_name' => 'v4.1-implementation-name',
        'v4_1_migration' => 'v4.1-migration',
        'v4_1_pnfs' => 'v4.1-pnfs',
        'v4_1_pnfs_striped_volumes' => 'v4.1-pnfs-striped-volumes',
        'v4_1_read_delegation' => 'v4.1-read-delegation',
        'v4_1_referrals' => 'v4.1-referrals',
        'v4_1_state_protection' => 'v4.1-state-protection',
        'v4_1_write_delegation' => 'v4.1-write-delegation',
        'v4_acl' => 'v4-acl',
        'v4_acl_max_aces' => 'v4-acl-max-aces',
        'v4_acl_preserve' => 'v4-acl-preserve',
        'v4_fsid_change' => 'v4-fsid-change',
        'v4_grace_seconds' => 'v4-grace-seconds',
        'v4_id_domain' => 'v4-id-domain',
        'v4_id_numeric' => 'v4-id-numeric',
        'v4_lease_seconds' => 'v4-lease-seconds',
        'v4_numeric_ids' => 'v4-numeric-ids',
        'v4_read_delegation' => 'v4-read-delegation',
        'v4_referrals' => 'v4-referrals',
        'v4_reply_drop' => 'v4-reply-drop',
        'v4_req_open_confirm' => 'v4-req-open-confirm',
        'v4_validate_symlinkdata' => 'v4-validate-symlinkdata',
        'v4_write_delegation' => 'v4-write-delegation',
        'v4_x_session_num_slots' => 'v4.x-session-num-slots',
        'v4_x_session_slot_reply_cache_size' => 'v4.x-session-slot-reply-cache-size',
        'vserver' => 'vserver',
        'vstorage' => 'vstorage'
      };

=over

=item Options

=over

=item C<< attributes => \@list_of_CS_attributes >>

(Mandatory)
The list of CS attributes for which to determine the relevant field names.

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

(Optional)
A command_interface from which the relevant CDEF can be obtained. In the
absence of this argument (or if this is a command_interface for a 7Mode host)
the algorithm described earlier is used.

=item C<< api => $api >>

(Optional)
The CMode CLI API which would have been invoked in the CS package.
This should be the API, so if "volume show" was invoked, then "volume_show"
is the api value to be provided.

If this is not specified, but the C<package> argument is specified, then
the API is determined from it (see explanation below)

In the absence of both this argument and the C<package> argument, the
algorithm described earlier is used to do the translation.

=item C<< package => $package_name >>

(Optional)
If this is provided, but the api is not, this package name is used to
determine which API would have been invoked, which would be the relevant
"show" command. For example, if the package is "NACL::CS::VserverNfs", the
API will be determined to be "vserver_nfs_show".

In the absence of both this argument and the C<package> argument, the
algorithm described earlier is used to do the translation.


=back

=back

=cut

sub get_hash_of_real_field_names {
    $Log->enter() if $may_enter;
    my %opts = validate_with(
        params => \@_,
        spec   => {
            _real_fields_common_validate_spec(),
            attributes => { type => ARRAYREF }
        }
    );
    my $attributes = delete $opts{attributes};

    # Re-calculating it for every attribute would be lunacy. Instead
    # calculate once and then pass it in for every call. Since it's just
    # a reference being passed around, passing it in every call incurs
    # next to no overhead.
    my $hashref = _get_mapping_hash_from_cdef(%opts);

    my %hash;
    foreach my $attribute (@$attributes) {
        $hash{$attribute} = get_real_field_name(
            %opts,
            attribute               => $attribute,
            _mapping_hash_from_cdef => $hashref
        );
    }

    $Log->exit() if $may_exit;
    return %hash;
}

=head2 get_real_field_name

    use NACL::ComponentUtils qw(get_real_field_name);
    ...
    my $field = get_real_field_name(
        attribute         => $attribute_name,
        command_interface => $ci,
        api               => $api
    );

                          OR

    my $field = get_real_field_name(
        attribute         => $attribute_name,
        command_interface => $ci,
        package           => $package_name
    );

                          OR

    my $field = get_real_field_name(attribute => $attribute_name);

Returns the real field name given a CS attribute name. See
L<get_hash_of_real_field_names|lib-NACL-ComponentUtils-pm/get_hash_of_real_field_names> for a detailed description of the options
accepted along with the algorithms employed. This method,
as opposed to C<get_hash_of_real_field_names>, is performed on only one
attribute and returns a single value rather than a hash. Also, instead
of accepting an C<attributes> argument, it accepts a single C<attribute>
as argument.

=cut

sub get_real_field_name {
    $Log->enter() if $may_enter;
    my %opts = validate_with(
        params => \@_,
        spec   => {
            _real_fields_common_validate_spec(),
            attribute => { type => SCALAR },

            # Undocumented. Help speed up execution by reading the CDEF
            # only once per call to get_hash_of_real_field_names,
            # rather than it being done for every attribute
            _mapping_hash_from_cdef => { type => HASHREF, optional => 1 }
        }
    );
    my $mapping_hash = delete $opts{_mapping_hash_from_cdef};
    my $attribute    = delete $opts{attribute};

    if ( !$mapping_hash ) {
        $mapping_hash = _get_mapping_hash_from_cdef(%opts);
    }

    if ( exists $mapping_hash->{$attribute} ) {
        $Log->exit() if $may_exit;
        return $mapping_hash->{$attribute};
    } else {
        my $field = $attribute;
        $field =~ s/^_//;
        $field =~ s/_/-/g;
        $field =~ s/(\d)-(\d)/$1.$2/g;
        $Log->exit() if $may_exit;
        return $field;
    }
}

sub _get_mapping_hash_from_cdef {
    $Log->enter() if $may_enter;
    my %opts = validate_with(
        params => \@_,
        spec   => { _real_fields_common_validate_spec() }
    );
    my $command_interface = $opts{command_interface};
    my $api               = $opts{api};
    if ( !defined $api && defined $opts{package} ) {
        $api = _convert_component_to_api( $opts{package} ) . '_show';
    }

    my $cdef;
    if ($command_interface) {
        if ( $command_interface->is_cmode() ) {
            if ($api) {
                my $apiset = $command_interface->apiset(
                    interface => 'CLI',
                    set       => 'CMode'
                );
                try {
                    $cdef
                        = $apiset->get_command_definition( command => $api );
                }
                catch NACL::APISet::Exceptions::MethodNotFoundException with {
                    $Log->warn( "The API '$api' is incorrect. Falling back "
                            . 'to the inexact algorithm to determine the '
                            . 'attribute mapping' );
                };
            }
        }
    }

    my %mapping_attr_to_real;
    if ($cdef) {
        my $alias_params = $cdef->get_alias_params();
        foreach my $field ( keys %$alias_params ) {
            my $attr
                = NACL::ComponentUtils->_translate_to_obj_field_name($field);
            $mapping_attr_to_real{$attr} = $field;
        }
    }

    $Log->exit() if $may_exit;
    return \%mapping_attr_to_real;
}

sub _real_fields_common_validate_spec {
    return (
        command_interface =>
            { %{ _ontap_ci_validate_spec() }, optional => 1 },
        _optional_scalars(qw(api package)),
    );
}

# Given a package name, convert it to the API method.
# For example, NACL::C::StorageAggregate (and NACL::CS::StorageAggregate)
# will return "storage_aggregate".
sub _convert_component_to_api {
    $Log->enter() if $may_enter;
    my ($full_compname) = validate_pos( @_, { type => SCALAR } );

    # Strip out the NACL::(C|CS)::
    $full_compname =~ /.*::(.*)$/;
    my $compname = $1;

    # Introduce a , before every capital letter
    $compname =~ s/([A-Z])/,$1/g;
    my @temp = split( /,/, $compname );

    # Shift out the first element because there will be a leading ,
    shift @temp;

    @temp = map { lc($_) } @temp;
    $Log->exit() if $may_exit;
    return join '_', @temp;
}

sub _response_exception_validate_spec {
    $Log->enter() if $may_enter;
    my %hash = (
        exception => {
            type => OBJECT,
            isa  => 'NACL::APISet::Exceptions::ResponseException'
        }
    );
    $Log->exit() if $may_exit;
    return wantarray ? %hash : {%hash};
}

sub _is_nacl_lib_loaded {
    $Log->enter() if $may_enter;
    my $lib_name = shift;
    # If $lib_name is autoused, it's possible calling ->can on it
    # will load the package.Therefore don't do the following
    #   my $loaded = $lib_name->can('new');

    my $loaded = 0;
    if ( nate_autouse_available() ){
        if (NATE::Autouse::_namespace_occupied($lib_name) ){
            $loaded = 1;
        }
    }
    else{
        $loaded = $lib_name->can('new');
    }
    $Log->exit() if $may_exit;
    return $loaded;
}

=head2 _get_required_filter_fields

    $pkg->_get_required_filter_fields(
        filter          => $filter,
        required_filter_fields => [ qw(field1 field2) ]
    );

This method checks the filter for all fields that are mandatory.

=over

=item Options

=over

=item C<< filter => $filter >>

(Required)
The filter hash-reference.

=item C<< required_fields => [ $field1, $field2 ] >>

(Required)
An array-reference of fields that are mandatory.

=back

=back

=cut

sub _get_required_filter_fields {
    $Log->enter() if $may_enter;
    my ( $pkg, @args ) = @_;
    my %opts = validate_with(
        params => \@args,
        spec   => {
            filter => { type => HASHREF, optional => 1  },
            _primary_keys => { type => ARRAYREF }
        },
        allow_extra => 1
    );
    my @required_filter_fields = @{$opts{'_primary_keys'} };
    my %required_filter_hash;

    foreach my $field (@required_filter_fields) {
        if ( exists($opts{$field})
             or exists($opts{filter}->{$field}) ) {
            $required_filter_hash{$field} = $opts{$field} || $opts{filter}->{$field};
            next;
        }
        my $error;
        if ( @required_filter_fields == 1 ) {
            $error = "'$required_filter_fields[0]' needs ";
        } else {
            my $last = pop @required_filter_fields;
            my @fields;
            foreach my $req_field (@required_filter_fields) {
                push @fields, "'$req_field'";
            }
            $error = join ', ', @fields;
            $error .= " and '$last' need ";
        }
        $error .= "to be provided as filter for "
                . "$pkg -> fetch() to work in GUI interface";
        $Log->exit() if $may_exit;
        NATE::BaseException->throw($error);
    }
    $Log->exit() if $may_exit;
    return \%required_filter_hash;
} #end _get_required_filter_fields

sub _base_check_gui {
    $Log->enter() if $may_enter;
    my ($pkg, %opts) = @_;

    try {
        $pkg->_get_required_filter_fields(%opts);
    }
    catch NATE::BaseException with {
        my $exception = shift;
        if ( $exception->text() =~ /provided as filter/ ) {
            $Log->exit() if $may_exit;
            my $primary_keys = join(",",@{$opts{'_primary_keys'}});
            NACL::Exceptions::InvalidChoice->throw(
                  "GUI cannot be used"
                . " as one or more of the required Primary keys \"$primary_keys\""
                . " is not specified for $pkg");
        }
        $Log->exit() if $may_exit;
        $exception->throw();
    };
    $Log->exit() if $may_exit;
    return;
}

sub nate_autouse_available {
    state $is_available;
    if ( ! defined $is_available){
        eval "require NATE::Autouse";
        if ($@){ $is_available = 0 } else { $is_available = 1 };
    }
    return $is_available;
}

1;