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

## @summary General Utility methods
## @author dl-nacl-dev@netapp.com
## @status shared
## @pod here

package NACL::GeneralUtils;

=head1 NAME

NACL::GeneralUtils

=head1 DESCRIPTION

C<NACL::GeneralUtils> is a collection of utility methods which are not
specific to any particular NACL layer and can be used outside of
NACL code as well. However, some of these methods might take existing
NACL structures. (such as APISet/C/CS/(S|M)Task objects)

=cut

use strict;
use warnings;

use NATE::Log qw(log_global);
my $Log = log_global();
my $may_enter = $Log->may_enter();
my $may_exit  = $Log->may_exit();
use Params::Validate qw(validate validate_with validate_pos :types);
use NATE::Exceptions::Argument qw(:try);
use NACL::ComponentUtils qw(Dumper _optional_scalars);
use NATE::Inc qw(get_file prepend);
use File::Spec;
use NATE::Log;
use feature 'state';
use POSIX qw/ceil/;

# We're using Math::Random::MT::Auto here since it allows for PRNGs
# scoped by object. This means that each object is a PRNG unto itself.
# It's also useful that the algorithm it employs (Mersenne Twister algorithm)
# is better than Perl's and its self-seeding mechanism is excellent.
# It works on both Windows and Linux, unlike Math::Random::MT (currently
# doesn't work on Windows)
use Math::Random::MT::Auto ':!auto';

use NATE::Events qw(call_on_fork_add);

BEGIN {
    use Exporter qw(import);
    our @EXPORT_OK
        = qw(arrange_by_create_time random_name_generator rand_words
        form_wordlist_from_dictionary
        _parse_hosts
        _copy_common_component_params
        _move_common_component_params
        _copy_common_component_params_with_ci
        _move_common_component_params_with_ci
        _copy_or_move_common_params
        _require_nate_version
        nacl_method_retry
        _log_profiling_data
        create_file
        delete_file
        _poll
        _powercycle
        get_random_hash
        _connect_to_client
        coredump_on_timeout
        free_data_lif
    );
}

=head2 _copy_common_component_params

    $pkg_or_obj->_copy_common_component_params(
        source => \%opts,
        target => \%target
    );

                or

    my $common_comp_params = $pkg_or_obj->_copy_common_component_params(
        source => \%opts
    );

This method is used to copy parameters common to all component calls
('method-timeout', apiset_must, apiset_should) from a source hash-reference
into a target hash-reference. ("copy" denotes that these parameters will
not be removed from the source hash-reference)

=over

=item Options

=over

=item C<< source => \%source >>

(Mandatory, HASHREF)
This is a reference to the options hash of the task method.

=item C<< target => \%target >>

(Optional, HASHREF)
The hash-reference into which to copy the common parameters.
This parameter does not need to be provided. If not provided, it will return
a hash-reference containing the common parameters.

=back

=back

=cut

sub _copy_common_component_params {
    $Log->enter() if $may_enter;
    my ($pkg_or_obj, %opts) = @_;
    $opts{target} ||= {};
    $pkg_or_obj->_copy_or_move_common_params(%opts, '_copy' => 1);
    $Log->exit() if $may_exit;
    return $opts{target};
}

=head2 _move_common_component_params

Similar to L<_copy_common_component_params|lib-NACL-TaskUtils-pm/_copy_common_component_params>,
however the common component parameters are moved out of the source hash-reference
and into the target hash-reference. (i.e. will be deleted from the source
hash-reference).

=cut

sub _move_common_component_params {
    $Log->enter() if $may_enter;
    my ($pkg_or_obj, %opts) = @_;
    $opts{target} ||= {};
    $pkg_or_obj->_copy_or_move_common_params(%opts, '_move' => 1);
    $Log->exit() if $may_exit;
    return $opts{target};
}

=head2 _copy_common_component_params_with_ci

Similar to L<_copy_common_component_params|lib-NACL-TaskUtils-pm/_copy_common_component_params>,
only difference being that the target hash-reference contains the
command_interface as well.

=cut

sub _copy_common_component_params_with_ci {
    $Log->enter() if $may_enter;
    my ($pkg_or_obj, %opts) = @_;
    $opts{target} ||= {};
    $pkg_or_obj->_copy_or_move_common_params(
        %opts,
        '_copy'    => 1,
        '_want_ci' => 1
    );
    $Log->exit() if $may_exit;
    return $opts{target};
}

=head2 _move_common_component_params_with_ci

Similar to L<_move_common_component_params|lib-NACL-TaskUtils-pm/_move_common_component_params>,
only difference being that the target hash-reference contains the
command_interface as well.

=cut

sub _move_common_component_params_with_ci {
    $Log->enter() if $may_enter;
    my ($pkg_or_obj, %opts) = @_;
    $opts{target} ||= {};
    $pkg_or_obj->_copy_or_move_common_params(
        %opts,
        '_move'    => 1,
        '_want_ci' => 1
    );
    $Log->exit() if $may_exit;
    return $opts{target};
}

=head2 _copy_or_move_common_params

This method provides the implementation for the methods
L<_copy_common_component_params|lib-NACL-TaskUtils-pm/_copy_common_component_params>,
L<_move_common_component_params|lib-NACL-TaskUtils-pm/_copy_common_component_params>,
L<_copy_common_component_params_with_ci|lib-NACL-TaskUtils-pm/_copy_common_component_params_with_ci>,
L<_move_common_component_params_with_ci|lib-NACL-TaskUtils-pm/_copy_common_component_params_with_ci>.
Task methods should not invoke this directly, but should instead go through
any of the methods listed above.

=over

=item Options

=over

=item C<< source => \%source >>

(Mandatory, HASHREF)
The source hash-reference from which to copy/move the common parameters.

=item C<< target => \%target >>

(Optional, HASHREF)
The hash-reference into which to copy/move the common parameters.
If not provided, then this method will create the target hash-reference.

=item C<< _copy => 0|1 >>

(Optional, BOOLEAN)
Either this parameter or '_move' should be provided. This specifies that
the parameters should be copied.

=item C<< _move => 0|1 >>

(Optional, BOOLEAN)
Either this parameter or '_copy' should be provided. This specifies that
the parameters should be copied.

=back

=back

=cut

sub _copy_or_move_common_params {
    $Log->enter() if $may_enter;
    my $pkg_or_obj = shift;
    my %opts       = validate_with(
        params => \@_,
        spec   => {
            source     => {type => HASHREF},
            target     => {type => HASHREF},
            '_copy'    => {type => BOOLEAN, optional => 1},
            '_move'    => {type => BOOLEAN, optional => 1},
            '_want_ci' => {type => BOOLEAN, default => 0}
        },
    );
    if (!$opts{_copy} && !$opts{_move}) {
        $Log->exit() if $may_exit;
        NATE::Exceptions::Argument->throw("Internal error: Either of '_copy' "
                . "or '_move' should have been set to 1 in the call to "
                . "'_copy_or_move_common_params()' but neither were");
    }

    if ($opts{_copy} && $opts{_move}) {
        $Log->exit() if $may_exit;
        NATE::Exceptions::Argument->throw("Internal error: Either of '_copy' "
                . "or '_move' should have been set to 1 in the call to "
                . "_copy_or_move_common_params()' but both were");
    }

    my $source = $opts{source};
    my $target = $opts{target};

    my $common_spec;
    if ($opts{_want_ci}) {
        $common_spec = $pkg_or_obj->_common_validate_spec();
    } else {
        $common_spec = $pkg_or_obj->_common_validate_spec_without_ci();
    }

    my @common_keys = keys %$common_spec;

    if ($opts{_copy}) {
        $pkg_or_obj->_hash_copy(
            source => $source,
            target => $target,
            copy   => \@common_keys
        );
    } else {
        $pkg_or_obj->_hash_move(
            source => $source,
            target => $target,
            move   => \@common_keys
        );
    }

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

=head2 arrange_by_create_time

B<DEPRECATED>. It is suggested that
L<< NACL::CS::Volume->sort_by_newest|lib-NACL-CS-Volume-pm/sort_by_newest >>
be used instead of this function.

    use NACL::GeneralUtils qw(arrange_by_create_time);
    ...

    my @cs_objects = NACL::CS::Volume->fetch(
        command_interface => $ci,
        requested_fields  => [ qw(create-time) ]
    );
    my @sorted_objs = arrange_by_create_time(volume_cs_objects => \@cs_objects);

(Applicable only for CMode)

This subroutine arranges NACL::CS::Volume objects in descending order
of creation time (i.e from volumes created last to volumes created earlier).

Note that it if a volume was offline at the time its creation time was queried
then the creation time will be unknown (the field will be returned as "-").
These volumes are placed at the end of the sorted list.

This is particularly useful when it's necessary to purge volumes in the
appropriate order. Purging a volume requires purging its clones (which in
turn would require purging its clones), and if it is a root-volume of a
vserver then it requires purging all the other volumes in the vserver
first. By arranging it in descending order, we're (nearly) guaranteeing that
we're purging them in the correct order.

=over

=item Options

=over

=item C<< volume_cs_objects => \@volumes_cs_objects >>

(Required)

An array-reference of NACL::CS::Volume objects, each of which should
have the C<create-time> field defined.

=back

=back

=cut

# Implementation moved into NACL::CS::Volume
sub arrange_by_create_time {
    require NACL::CS::Volume;
    $Log->enter() if $may_enter;
    if ($Log->may_debug()) {
        $Log->debug("Opts to 'arrange_by_create_time':\n" . Dumper({@_}));
    }
    my %opts = validate(@_, {volume_cs_objects => {type => ARRAYREF}});
    my @sorted_list = NACL::CS::Volume->sort_by_newest(
        state_objs => $opts{volume_cs_objects});
    $Log->exit() if $may_exit;
    return @sorted_list;
}

=head2 random_name_generator

    use NACL::GeneralUtils qw(random_name_generator);
    ...

    my $random_name = random_name_generator(
        # All of these are optional
        [ prefix => $prefix, ]
        [ suffix => $suffix, ]
        [ size   => $num_words, ] # default 2
        [ %other_opts ]
    );

This function generates a random name which is of the following form:

<prefix>_<rand-word1>_<rand-word2>_<timestamp>_<suffix>

(The prefix and suffix are present only if those arguments are provided
in the call, and while it defaults to having two random words present
in it, this can be customized by using the C<size> argument)

This uses L<rand_words|lib-NACL-GeneralUtils-pm/rand_words> to obtain the
random words present in the random name returned. By default, the dictionary
available at NACL/Tools/RNG/dictionary is used to obtain the random words
though this can be overridden by using the C<custom_dictionary> or
C<wordlist> arguments (see L<rand_words|lib-NACL-GeneralUtils-pm/rand_words>
for a description of the default dictionary as well as the C<custom_dictionary>
and C<wordlist> arguments)

The prefix and suffix are optional and can be used to specify constant
portions of the random name generated. (these could be things such as element
type or test case name)

=over

=item Options

=over

=item C<< prefix => $prefix >>

(Optional)

A prefix for the random name.

=item C<< suffix => $suffix >>

(Optional)

A suffix for the random name.

(STasks typically use this to specify the type of element being created. For
example, NACL::STask::Volume sets the suffix to be "vol" so that all volumes
created with random names will end with "_vol".)

=item C<< size => $number_of_random_words_in_name >>

(Optional, defaults to 2)

The number of random words to be present in the random name returned.

=item C<< length => $length_of_string >>

(Optional)
This argument is to be used to specify the length of the random word string
that gets generated. Note that this takes precedence over C<size> if both
are provided.

=item Other options

This accepts all of the other options accepted by
L<rand_words|lib-NACL-GeneralUtils-pm/rand_words>.

=back

=back

=cut

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,
    },
);

# Contains all of the words in the default dictionary (is an array-reference)
my $Random_Words_Dictionary;

use constant DICTIONARY_LOCATION => 'NACL/Tools/RNG/dictionary.txt';

#Using Range of utf character ,by default utf charatcer picks from this range

use constant RANGE => '0x4E00,0x9FFF';

sub random_name_generator {
    $Log->enter() if $may_enter;
    my %opts = validate_with(
        params => \@_,
        spec   => {
            _optional_scalars(qw(prefix suffix length )),
            size        => {type => SCALAR,  default => 2},
	    word_chars  => {type => SCALAR,  default => 1},
	    other_chars => {type => ARRAYREF,default => []},
        },
        allow_extra => 1    # Allow options for rand_words
    );
    my $word_chars  = delete $opts{word_chars};
    my $other_chars = delete $opts{other_chars} ;
    my $prefix = delete $opts{prefix};
    my $suffix = delete $opts{suffix};
    my $length = $opts{length};

    my ($candidate_name,@words,$random_name,$utf_name) ;
    my $time = time();

    #Initializing to 1 because there will always be 1 underscore for time()
    my $extra_underscores = 1;

    if(!$word_chars && !scalar(@$other_chars)) {
       $candidate_name = get_utf_8_names(%opts);
       @words = split '' ,$candidate_name;
    }else {
        if($word_chars){
            @words = rand_words(%opts) ;
            if ($length) {
            # Each word should have at least one character, so we are going to
            # overshoot the desired length.
                $candidate_name = join("_", @words);
            }
        }

        if(scalar(@$other_chars)) {
            $opts{other_chars} = $other_chars ;
            $utf_name  = get_utf_8_names(%opts) ;
            #if $candidate_name is defined then $utf_name will concatenate else $candidate_name will be $utf_name
            if(length($candidate_name)) {
                $candidate_name.='_'.$utf_name ;
            }else {
                $candidate_name = $utf_name ;
            }
        }
    }

    my $prefix_length = 0;
    if (defined $prefix && $prefix ne '') {
        $prefix_length = length($prefix);
        $extra_underscores++;
    }
    my $suffix_length = 0;
    if (defined $suffix && $suffix ne '') {
        $suffix_length = length($suffix);
        $extra_underscores++;
    }

    if($length) {
        # 13(10+1+1+) is added to compensate for length of time()(length is 10) and three underscores.
        my $length_excess = length($candidate_name) + $prefix_length + $suffix_length + 10 + $extra_underscores - $length;

        # Chop any excess characters off from back of the string.
        if($length_excess > 0) {
           if(scalar(@$other_chars) && $word_chars) {
               #excess length will be remove from both $candidate_name and utf name, So here divideng by 2
               my $extra_length = ceil(($length_excess )/2) ;
               $candidate_name = substr $candidate_name, 0, -$extra_length ;
               $candidate_name = substr $candidate_name, ($length_excess - $extra_length);
           }
           else {
               $candidate_name = substr $candidate_name, 0, -$length_excess ;
           }
        }

        $random_name = _construct_name($prefix,$time,$suffix,$candidate_name) ;

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

    $random_name = _construct_name($prefix,$time,$suffix,@words) ;

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

sub _construct_name {
    my ($prefix,$time,$suffix,@words) = @_;

    my $random_name = join '_', @words, $time;

    if ($prefix) {
        $random_name = "${prefix}_$random_name";
    }

    if ($suffix) {
        $random_name = "${random_name}_$suffix";
    }

    return $random_name;
}

=head2 rand_words

    use NACL::GeneralUtils qw(rand_words);
    ...

    my @random_words = rand_words(
        size => $num_of_random_words, # Mandatory
        [ custom_dictionary => $path_to_dictionary, ]
        [ wordlist          => \@wordlist ]
    );

Returns an array of words randomly chosen (the C<size> argument
is the number of words returned). By default the words are chosen from
the dictionary available at NACL/Tools/RNG/dictionary, though it can
be overridden to choose random words from a separate dictionary or from
a specific wordlist (see the C<custom_dictionary> and C<wordlist> arguments
described in detail below)

The default dictionary is a pruned version of the dictionary used by
Data::Random. All words which contain more than 10 characters have been
removed (rationale: the words returned shouldn't be unwieldy, so we limit
to words up to 10 characters of length). Also, special characters such as
single quotes or hyphens have been removed from all words (this is because
many elements can only be named with alphanumeric characters and underscores)

This function helps ensure that processes spawned in parallel do not
end up getting the same random names by setting the seed for rand() as
the PID of that process.

=over

=item Options

=over

=item C<< length => $length >>

(Optional)

Total number of words returned should have length
(calculated using concatenating words together using _ as delimiter) >= $length.

=item C<< size => $number_of_random_words >>

(Optional)

Default is 1. The number of words to randomly retrieve.

=item C<< custom_dictionary => $path_to_dictionary >>

(Optional)

This argument can be used to specify a custom dictionary from which to
randomly return words.

(By default random words are picked from the dictionary available at
NACL/Tools/RNG/dictionary.)

Note that many ONTAP elements allow only alphanumberic characters and
underscore (i.e. a-z, A-Z, 0-9, _) in their names. If the random names
returned by this method are used for creation of ONTAP elements then it
will be necessary to ensure that words with non-alphanumeric characters are
not present in the dictionary.

=item C<< wordlist => \@words >>

(Optional)

An array of words from which to randomly choose words. Note that if both
this argument and the C<custom_dictionary> argument are provided, then words
are chosen from the words provided through this argument.

(The same caveat regarding alphanumeric characters described under the
C<custom_dictionary> argument applies to this argument as well)

A scenario where it might be useful to provide the words through this
argument is if multiple calls to this function is made with a custom dictionary
specified. This is because when a custom dictionary is provided, then each call
to this function requires first reading the dictionary. Multiple calls to this
function would hence incur the file IO costs on each call. For example, calls
like these:

    my @rand_words1 = rand_words(size => $size, custom_dictionary => $dictionary);
    my @rand_words2 = rand_words(size => $size, custom_dictionary => $dictionary);
    my @rand_words3 = rand_words(size => $size, custom_dictionary => $dictionary);

Can be made more efficient by reading the file once, forming the word-list
(see
L<form_wordlist_from_dictionary|lib-NACL-GeneralUtils-pm/form_wordlist_from_dictionary>)
and passing that in each call:

    my @wordlist = form_wordlist_from_dictionary(custom_dictionary => $dictionary);
    my @rand_words1 = rand_words(size => $size, wordlist => \@wordlist);
    my @rand_words2 = rand_words(size => $size, wordlist => \@wordlist);
    my @rand_words3 = rand_words(size => $size, wordlist => \@wordlist);

=back

=back

=cut

sub rand_words {
    $Log->enter() if $may_enter;
    my %opts = validate(
        @_,
        {   size     => {type => SCALAR, default => 1,},
            wordlist => {type => ARRAYREF, optional => 1},
           _optional_scalars(qw(custom_dictionary length))
        }
    );

    my $wordlist;

    if ($opts{wordlist}) {
        $wordlist = $opts{wordlist};
    } elsif ($opts{custom_dictionary}) {
        $wordlist = form_wordlist_from_dictionary(
            custom_dictionary => $opts{custom_dictionary});
    } else {
        if ($Random_Words_Dictionary) {
            $wordlist = $Random_Words_Dictionary;
        } else {
            $wordlist = form_wordlist_from_dictionary(
                custom_dictionary => DICTIONARY_LOCATION);
            $Random_Words_Dictionary = $wordlist;
        }
    }

    my $length = $opts{length} || 0;

    my $size_of_dictionary = @$wordlist;
    my @random_words;
    my $length_till_now = 0;
    while (@random_words < $opts{size} or $length > $length_till_now) {
        my $random_number = int($Global_MT_Obj->rand($size_of_dictionary));
        my $next_word = $wordlist->[$random_number];
        $length_till_now += length($next_word) + 1;
        push @random_words, $next_word;
    }

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

=head2 form_wordlist_from_dictionary

    use NACL::GeneralUtils qw(form_wordlist_from_dictionary);
    ...
    my $wordlist = form_wordlist_from_dictionary(custom_dictionary => $dictionary);

This function returns an array-reference of words when provided with the path
to a custom dictionary.

=cut

sub form_wordlist_from_dictionary {
    $Log->enter() if $may_enter;
    my %opts = validate(@_, {custom_dictionary => {type => SCALAR}});
    my $file_contents = NATE::Inc::get_file($opts{custom_dictionary});
    if (!$file_contents) {
        $Log->exit() if $may_exit;
        NATE::Exceptions::Argument->throw('Could not read the contents '
                . "of $opts{custom_dictionary}. This is either because "
                . 'the file has no contents or because it could not be '
                . 'found in @INC. @INC: '
                . "@INC\n");
    }
    my @wordlist = split /\s+/, $file_contents;
    $Log->exit() if $may_exit;
    return \@wordlist;
}

=head2 get_utf_8_names
This function return utf character string. There are 2 cases:-
case1: if user passes array of utf character then $utf_name contain only those characters
case2: if user not passing any array of utf character then $utf_name contain only charcter
       from default range('0x4E00,0x9FFF')

=cut

sub get_utf_8_names {
    $Log->enter() if $may_enter;
    my %args = @_;
    ## If user does not passes length value then by default maxlen will be 65
    my $maxlen = $args{length} || 65;

    my (@test_chars ,@names);

    my @other_chars ;

    ## When user not passes other_chars array then by
    ## default other_chars will be initialized by empty array ref
    my $other_chars = $args{other_chars} || [] ;
    if ( scalar @$other_chars){
        @other_chars = @$other_chars ;
        ## Taking a char randomly from @other_chars and pushing into @names untill maxlen
        push @names ,map { (@other_chars)[rand scalar(@other_chars)] } 1..$maxlen ;
    }
    else {
        my($min,$max) = split(/\s*,\s*/, RANGE);
        chomp($min);
        chomp($max);
        my $chars = get_chars_for_range(
            min => $min,
            max => $max,
        );
        push @test_chars, @$chars;
        push @names ,map { (@test_chars) [rand scalar(@test_chars)] } 1..$maxlen ;
    }

    foreach my $i(1 ... @names){
       utf8::decode($names[$i]);
    }
    my $utf_name = join '',@names ;

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

sub get_chars_for_range {
    my %args = @_;
    my $min = $args{min};
    my $max = $args{max};
    my @chars;
    my $first = hex($min);
    my $last  = hex($max);
    foreach my $cp ($first .. $last) {
        my $char = chr($cp);
        if ($char =~ /\X/) {  # matches a single user-visible character
            push @chars, $char;
        }
    }
    return \@chars;
}

# Private Method to parse the hostrec definition provided by the user.
# Input constitutes the hostrec string provided by the user
# Output constitutes a hash where keys are the name/hostid and values
# are the corresponding hostspec definition .
# Example Use
##          use Tie::IxHash;
##          my %arr;
##          tie %arr, 'Tie::IxHash';
##          %arr = _parse_hosts('a;hosttype=filer;default_ip_gx=0.0.0.0,b,c;hosttype=filer');
##          $Log->comment(Dumper \%arr);

sub _parse_hosts {
    my ($hostspecs) = @_;
    my @hostspec_pairs = ();
    while (1) {
        last if ($hostspecs =~ /\G$/cg);    # exit loop on empty string
        my $oldpos = pos($hostspecs) || 0;
        my $hostid = Hostrec::parse_host_spec(
            {},                             # partial_hostrec
            \$hostspecs,                    # contentref
            0,                              # allow_connspec
            0,                              # comment_allowed
            undef,                          # hostid
            "host spec '$hostspecs'",       # source
            1,                              # allow_many_hosts
        );
        my $newpos = pos($hostspecs);
        my $hostspec = substr($hostspecs, $oldpos, $newpos - $oldpos);
        $hostspec =~ s/[:,]$//g;
        next if !$hostid; # filter out any empty strings due to param concatenation of optional params
        push @hostspec_pairs, ($hostid => $hostspec);
    }
    return @hostspec_pairs;
}

# Require a particular version of NATE be running.
sub _require_nate_version {
    $Log->enter() if $may_enter;
    my %opts = validate_with(
        params => \@_,
        spec   => {
            version => {type => SCALAR},
            _optional_scalars(qw(method error_msg)),
            is_connectrec => {type => BOOLEAN, default => 0},
        }
    );
    my $version = $opts{version};

    if (!$opts{error_msg} && !$opts{method}) {
        my $me = (caller(0))[3];
        $Log->exit() if $may_exit;
        NATE::Exceptions::Argument->throw("Either of the arguments 'method' "
                . "or 'error_msg' should be provided in the call to '$me'");
    }

    eval "use NATE $version";
    if ($@) {
        my $error_msg;
        if (defined $opts{error_msg}) {
            $error_msg = $opts{error_msg};
        } else {
            my $caller = (caller(1))[3];
            my $method = $opts{method};
            my $host_or_connectrec
                = $opts{is_connectrec} ? 'Connectrec' : 'Hostrec';
            $error_msg
                = "This method ($caller) "
                . "uses the $host_or_connectrec method '$method' which "
                . "is available only from NATE version $version but an "
                . "older version of NATE is being run.\n$@\n";
        }
        $Log->exit() if $may_exit;
        NATE::BaseException->throw($error_msg);
    }
    $Log->exit() if $may_exit;
}

=head2 nacl_method_retry

    # See below for a more specific example
    use NACL::GeneralUtils qw(nacl_method_retry);
    ...
    nacl_method_retry(
        code => sub { ... Original code here ... },
        tries_count => $count,
        sleep_time  => $time_in_seconds,
        exceptions  => $exception_name | \@exception_names,
        num_times_code_ran => \$num                          # Optional
    );

There are numerous instances where an operation fails because the element
being operated on is temporarily busy/in use. Examples of these are:

=over

=item * Attempting to modify an aggregate while it is busy (in the middle of
a WAFL checkpoint operation, for example)

=item * Attempting to purge a volume while a snapshot schedule is in progress

=item * Deleting a snapshot may fail when the snapshot is in transferring status

=item * Attempting to purge a volume while it is busy

=back

For cases like those listed above, the only solution is to retry the method
multiple times. This method is a helper for retrying other NACL methods.

For example, consider code like this:

    $aggr_obj->modify(state => 'offline');

Let's say this fails because the aggregate is busy. The way we would use
this method to retry the above code 3 times, sleeping for 10s between each
attempt would be like this:

    nacl_method_retry(
        code        => sub { $aggr_obj->modify(state => 'offline'); },
        tries_count => 3,
        sleep_time  => 10,
        exceptions  => 'NACL::C::StorageAggregate::CurrentlyBusy'
    );

The method call which was originally failing needs to be sent with a
code-reference (achieved by placing within an anonymous subroutine, like
shown above).

=over

=item Options

=over

=item C<< code => sub { ... Code here ... } >>

A code-reference of the code to be retried.

=item C<< tries_count => $count >>

(Defaults to 5)
The number of times to try running the method.

=item C<< sleep_time => $time_in_seconds >>

(Defaults to 30 seconds)
The time to sleep between invocations of the method.

=item C<< exceptions => $exception_name | \@array_of_exception_names >>

(Either a scalar or an array-reference)
This is the name of exception (or exceptions) which should be caught and
ignored.

=item C<< num_times_code_ran => \$num_times_code_ran >>

(Optional, is a reference to a scalar variable)
This argument can be used to obtain the number of times the code-reference
was invoked before it succeeded.

=back

=back

=cut

sub nacl_method_retry {
    $Log->enter() if $may_enter;
    my %opts = validate_with(
        params => \@_,
        spec   => {
            code               => {type => CODEREF},
            tries_count        => {type => SCALAR, default => 5},
            sleep_time         => {type => SCALAR, default => 30},
            exceptions         => {type => SCALAR | ARRAYREF},
            num_times_code_ran => {type => SCALARREF, optional => 1},
        }
    );

    if ($opts{tries_count} < 1) {
        $Log->exit() if $may_exit;
        NATE::Exceptions::Argument->throw('The value of the '
                . "'tries_count' argument in the call to nacl_method_retry "
                . "should have been greater than or equal to 1 but was provided as "
                . "$opts{tries_count}\n");
    }

    # sleep_time can be fractional (i.e. 0.5 is fine)
    if ($opts{sleep_time} <= 0) {
        $Log->exit() if $may_exit;
        NATE::Exceptions::Argument->throw('The value of the '
                . "'sleep_time' argument in the call to nacl_method_retry "
                . "should have been greater than 0 but was provided as "
                . "$opts{sleep_time}\n");
    }

    my $tries_count = $opts{tries_count};
    my $code        = $opts{code};
    my $sleep_time  = $opts{sleep_time};

    my $exceptions;
    if (ref $opts{exceptions}) {
        $exceptions = $opts{exceptions};
    } else {
        $exceptions = [$opts{exceptions}];
    }

    my $exception_caught;
    my $sleep_sub = sub {
        $exception_caught = $_[0];
        Tharn::snooze($sleep_time);
    };

    my %except_return;
    foreach my $exception (@$exceptions) {
        $except_return{$exception} = $sleep_sub;
    }

    # We capture the return value in an array to handle all cases. If the
    # return value of the method was a scalar, the array would have only
    # a single value and later the wantarray would take care of ensuring
    # only the first element (i.e. the scalar return value) is returned.
    # If the return value is an array, it would obviously be fine.
    # If the return value is a hash, then the array would get cast into
    # a hash.
    my @return;

    # Flag to determine if the code ran successfully. Note that checking
    # if the @return array has elements is not sufficient to determine
    # if the code succeeded. This is because if the underlying method
    # ends with a "return;", then the array @return will continue to
    # be empty despite the code having executed successfully.
    my $done;

    # $tries_count will remain being the original value, we'll iterate
    # over $retry_counter
    my $retry_counter = $tries_count;
    while ($retry_counter--) {
        try {
            @return = $code->();
            $done   = 1;
        }
        except {
            return \%except_return;
        };
        last if $done;
    }

    unless ($done) {
        $exception_caught->set_text("After $tries_count iterations "
                . "with a sleep of $sleep_time seconds between iterations, "
                . "the method still failed. Original failure:\n"
                . $exception_caught->text());
        $Log->exit() if $may_exit;
        $exception_caught->throw();
    }

    my $num_times_code_ran = $tries_count - $retry_counter;

    # Log how many times the code ran only if it ran more than once
    if ($num_times_code_ran > 1) {
        $Log->comment("The code-reference was invoked $num_times_code_ran "
                . 'before it succeeded');
    }

    if ($opts{num_times_code_ran}) {
        ${$opts{num_times_code_ran}} = $num_times_code_ran;
    }

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

# This method logs the profiling data in a single-line parse-able format
sub _log_profiling_data {
    $Log->enter() if $may_enter;
    my ( $self, @opts ) = @_;
    my %args = validate_with(
        params => \@opts,
        spec   => {
            command      => { type => SCALAR },
            node         => { type => SCALAR },
            start_time   => { type => SCALAR },
            end_time     => { type => SCALAR },
            elapsed_time => { type => SCALAR },
            interface    => { type => SCALAR },
        }
    );
    my $runid = Tharn::param('RUNID');
    my $node             = $args{node};
    my $profile_log_path = $runid . '_' . 'profile.log';
    my $logdir = Tharn::param('LOGDIR');
    my $jobid = Tharn::param('JOBID');
    $logdir =~ s/(\w+.*\/$jobid).+/$1/;
    my $path
        = File::Spec->catfile( $logdir,'Command_profile_data', $profile_log_path);
    my $logspec = "<tharn>(level=comment)";
    my $separate_log_for_profile_data
        = Tharn::param('SEPARATE_LOG_FOR_PROFILE_DATA') || 0;
    my $message;
    try {
        $message
            = "host=($node) interface=($args{interface}) command=($args{command}) start=($args{start_time}) "
            . "end=($args{end_time}) elapsed=($args{elapsed_time}s)";
        if ($separate_log_for_profile_data) {
            my $log = NATE::Log->new($logspec);
            $log->log( $message, path => $path);
        } else {
           $Log->comment($message);
        }
    }
    catch NATE::BaseException with {
        my $exception_object = shift;
        $Log->warn( "Unable to create a separate log file because "
                . $exception_object->text()
                . " So, displaying the profiling data in the same file" );
        $Log->comment($message);
    };

    $Log->exit() if $may_exit;

}

=head2 create_file

    use NACL::GeneralUtils qw(create_file);
    ...

    create_file(
        filepath => $filepath,
        client   => $client_ci
    );

    or

    create_file(
        filepath => $filepath,
        apiset   => $client_apiset_object
    );

Creates a file in the specified filepath on the client. This method is useful
for the cases in which only creation of file is needed. If performing file
operations and control of file handles are needed, then
NACL::C::Client::Remote::File can be used.

The advantage offered by this method over NACL::C::Client::Remote::File
in file creation is that, it doesn't spawn
a process in the remote client for performing file creation and so proper
setting of NATE_LIB, LOGDIR (which are needed for spawning the remote process)
is not needed. File creation will be achieved through native OS based commands.

=over

=item Options

=over

=item C<< client => $client_ci >>

(Optional)

The client command interface which is of type NACL::C::Client.
Either of 'client' or 'apiset' should be specified.

=item C<< apiset => $client_apiset_object >>

(Optional)

The client apiset object.
Either of 'client' or 'apiset' should be specified.

=item C<< filepath => $filepath >>

(Mandatory)

The path to the file to be created.

=back

=back

=cut

sub create_file {
    # A very light weight approach of file creation is needed.
    # NACL::C::Client::Remote::File starts a remote process which
    # needs NATE_LIB, LOGDIR set appropriately and this is a
    # hard requirement for certain usecases. This solution will serve
    # the cases in which just files need to be created and performing
    # other file operations are not needed.
    $Log->enter() if $may_enter;
    my %args = validate_with(
        params => \@_,
        spec   => {
            client      =>  { type => OBJECT, isa => 'NACL::C::Client', optional => 1 },
            apiset      =>  {type => OBJECT, isa => 'NACL::APISet::Host::CLI', optional => 1},
            filepath    => { type => SCALAR },
        },
    );
    unless ($args{client} || $args{apiset}) {
        $Log->exit;
        NATE::Exceptions::Argument->throw("Either of the options 'client' or ".
            "'apiset' should be specified");
    }
    my $apiset = (defined $args{apiset})? $args{apiset} : $args{client}->apiset(interface => "CLI");
    if ( $apiset->isa('NACL::APISet::Host::CLI::Windows' )) {
        $apiset->copy(
            'suppress-prompt' => 1,
            source           => 'NUL',
            destination      => $args{filepath}
        );
    } else {
        $apiset->touch( path => $args{filepath} );
    }
    $Log->exit;
}

=head2 delete_file

    use NACL::GeneralUtils qw(delete_file);
    ...

    delete_file(
        filepath => $filepath,
        client   => $client_ci
    );

    or

    delete_file(
        filepath => $filepath,
        apiset   => $client_apiset_object
    );

Deletes a file in the specified filepath on the client. This method is useful
to cleanup the file created by the create_file method. If performing file
operations and control of file handles are needed, then
NACL::C::Client::Remote::File can be used.

The advantage offered by this method over NACL::C::Client::Remote::File
in file deletion is that, it doesn't spawn
a process in the remote client for performing file deletion and so proper
setting of NATE_LIB, LOGDIR (which are needed for spawning the remote process)
is not needed. File deletion will be achieved through native OS based commands.

=over

=item Options

=over

=item C<< client => $client_ci >>

(Optional)

The client command interface which is of type NACL::C::Client.
Either of 'client' or 'apiset' should be specified.

=item C<< apiset => $client_apiset_object >>

(Optional)

The client apiset object.
Either of 'client' or 'apiset' should be specified.

=item C<< filepath => $filepath >>

(Mandatory)

The path to the file to be deleted.

=back

=back

=cut

sub delete_file {
    $Log->enter() if $may_enter;
    my %args = validate_with(
        params => \@_,
        spec   => {
            client      =>  { type => OBJECT, isa => 'NACL::C::Client', optional => 1 },
            apiset      =>  {type => OBJECT, isa => 'NACL::APISet::Host::CLI', optional => 1},
            filepath    => { type => SCALAR },
        }
    );
    unless ($args{client} || $args{apiset}) {
        $Log->exit;
        NATE::Exceptions::Argument->throw("Either of the options 'client' or ".
            "'apiset' should be specified");
    }
    my $apiset = (defined $args{apiset})? $args{apiset} : $args{client}->apiset;
    if ( $apiset->isa('NACL::APISet::Host::CLI::Windows' )) {
        $apiset->del(
            'force-delete' => 1,
            'quiet-mode'   => 1,
            files          => $args{filepath}
        );
    } else {
        $apiset->rm( paths => $args{filepath}, force => 1 );
    }
    $Log->exit;
}

#===============================================================================
# Method:    _powercycle
# Objective: powercycling the client given by the command interface
# Options:
# client_to_powercycle - required - A NACL::C::Client object of the client
# Output: Returns error if powercycle command is not found else nothing
# is returned.
#===============================================================================
sub _powercycle {
    $Log->enter() if $may_enter;
    my %opts = validate_with(
        params => \@_,
        spec   => {
            client_to_powercycle => { type => OBJECT, isa => "NACL::C::CommandInterface" },
            retries              => { type => SCALAR },
            verify_cmd           => { type => SCALAR, default => "echo hello" },
        },
    );

    my $result;
    my $retries              = $opts{retries};
    my $client_to_powercycle = $opts{client_to_powercycle};
    my $client               = $client_to_powercycle->hostrec->hostname();

    if ( $client_to_powercycle->hostrec->powercmd() ) {

        #using eval since the error will be of NATE::Result::Fatal type
        eval { $client_to_powercycle->hostrec->powercycle(); };
        if ($@) {
            $Log->exit() if $may_exit;
            NATE::BaseException->throw(
                "rpower needs to be configured on this client.\n" .
                "Error from call to powercycle: " . join (" ", $@->messages()));
        }
        $result = _poll(
            command_interface => $client_to_powercycle,
            retries           => $retries,
            verify_cmd        => $opts{verify_cmd},
        );
        if ( $result == 1 ) {
            $Log->debug("Client \"$client\" rebooted after power cycle");
        } else {
            $Log->exit() if $may_exit;
            NATE::BaseException->throw(
                "Client \"$client\" did not reboot after power cycle");
        }
    } else {
        $Log->exit() if $may_exit;
        NATE::BaseException->throw(
            "Powercycle is not supported on this client");
    }

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

#===============================================================================
# Name : _poll()
# Description : Method to poll the client.
# Input Parameters : command_interface,ostype,retries
# Return Values : 1 - if client rebooted successfully
#                        0 - failed to reboot the client
#===============================================================================
sub _poll {
    $Log->enter() if $may_enter;
    my %opts = validate_with(
        params => \@_,
        spec   => {
            command_interface => { type => OBJECT, isa => "NACL::C::CommandInterface" },
            retries           => { type => SCALAR },
            verify_cmd        => { type => SCALAR, default => "echo hello" },
        },
    );

    my ( $output, $max_tries );
    my $command_interface = $opts{command_interface};
    my $retries           = $opts{retries};
    my $verify_cmd        = $opts{verify_cmd};
    my $client            = $command_interface->hostrec->hostname();

    $max_tries = 0;

    #Checking the connectivity to client immediately after reboot execution .
    eval {
        $max_tries++;
        _connect_to_client(
            command_interface => $command_interface,
            verify_cmd        => $verify_cmd,
        );
    } until ( $@ || $max_tries >= $retries );

    # NetAppNetwork(corduroyl) switches takes around a minute before
    # returning the control to NATE. Most probably it must already have rebooted
    # by the time NATE try to reconnect to it. So no need to rpower the
    # switch if it is connecting(alive).
    if ( !$@ and $command_interface->hostrec()->hosttype !~ /corduroy/i) {
        $Log->debug( "Client \"$client\" remained alive (always "
                . "responded to polls, and so it must not have actually "
                . "rebooted/powercycled)" );
        $Log->exit() if $may_exit;
        return 0;
    }

    $Log->debug("Client \"$client\" in shutting down state....");

    #Now the client is in shutdown state
    $max_tries = 0;

    #Performing $retries times of reconnecting
CONNECT: {
        use warnings qw(exiting);
        try {
            $output = _connect_to_client(
                command_interface => $command_interface,
                verify_cmd        => $verify_cmd,
            );
        }
        catch NATE::BaseException with {
            my $err_obj = shift;
            if ((   $err_obj->text()
                    =~ /(Could not write to connection .*)|(Could not create connection.*)|(Unexpected EOF.*)|(Timed out.*)|(Connection timed out.*)|(too many prompts without progress.*)|(Bad file descriptor.*)/i
                )
                && ( $max_tries < $retries )
                ) {
                $max_tries++;
                no warnings qw(exiting);
                sleep(10);    #polling between each retry
                redo CONNECT;
            } elsif ( $max_tries >= $retries ) {
                $Log->debug(
                    "Client \"$client\" never responded after $retries retries"
                );
                $Log->exit() if $may_exit;
                return 0;
            } else {
                 $err_obj->throw();
            }
        }
    }

    $Log->exit() if $may_exit;
    return 1;
} ## end sub _poll()

#===============================================================================
# Name : _connect_to_client()
# Description : Method to connect to the client & execute "echo" command.
# Input Parameters : command_interface , ostype
# Return Values : no return value
#===============================================================================
sub _connect_to_client {
    $Log->enter() if $may_enter;
    my %opts = validate_with(
        params => \@_,
        spec   => {
            command_interface => { type => OBJECT, isa => "NACL::C::CommandInterface" },
            verify_cmd        => { type => SCALAR },
        },
    );
    my ( $apiset, $output );
    my $command_interface = $opts{command_interface};

    $command_interface->refresh_command_interface( no_version_change => 1 );

    $apiset = $command_interface->apiset();

    $apiset->execute_raw_command( command => $opts{verify_cmd} );
    $Log->exit() if $may_exit;
    return;
} ## end sub _connect_to_client

=head2 get_random_hash

    use NACL::GeneralUtils qw(get_random_hash);
    ...

    get_random_hash(
        hashref => $hashref,
    );

This function takes hash reference as an input ,constructs a hash with random
key value pair and returns the constructed hash as a reference

=over

=item Options

=over

=item C<< hashref => $hashref >>

(Required)  Input hash reference

=back

=back

=cut

sub get_random_hash {
    $Log->enter() if $may_enter;
    my %opts = validate_with(
        params => \@_,
        spec   => {
            hashref  => { type => HASHREF },
        },
    );
    my (%random_hash, @arr, $val);
    my $ref = $opts{hashref};
    my @keys = keys %$ref;

    #$no_of_index decides the no of rows in the hash
    my $no_of_index = int rand @keys + 1;
    foreach( my $count=0; $count < $no_of_index; $count++ ) {
        my $randindex = int rand @keys;
        $val = $ref->{$keys[$randindex]};
        #If the value is an array ,choose a random element from it
        if ( ref $val eq "ARRAY" ) {
            my @arr = @$val;
            $val = $arr[int rand @arr];
        }
        $random_hash{$keys[$randindex]}=$val;
    }
    $Log->exit() if $may_exit;
    return \%random_hash;
}

sub coredump_on_timeout {
    $Log->enter() if $may_enter;
    my (@args) = @_;

    state $spec = {
        command_interface => {type => OBJECT, isa => "NACL::C::CommandInterface::ONTAP", optional => 1},
        conn              => {type => OBJECT, isa => "Connectrec", optional => 1},
    };

    my %opts = validate_with(
        params => \@args,
        spec   => $spec,
    );

    $Log->comment("#" x 100);
    $Log->comment(
        "The test has failed because of timeout. " .
        "User has requested coredump on timeout. " .
        "Starting coredump on this node."
    );
    $Log->comment("#" x 100);

    my $ci = $opts{command_interface};
    my $conn = $opts{conn};
    if ((!defined $ci) and (!defined $conn)) {
        $Log->comment("Unable to dump core. Either command_interface OR connection object is needed");

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

    if(!defined $ci) {
        if ($conn->hostp()->hosttype() =~ /filer-ng/) {
            $ci = NACL::C::Node->new(hostrec => $conn->hostp());
        } else {
            $Log->comment("Skipping coredump. It is only supported for CMODE filers");

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

    try {
        NACL::STask::Node->panic(
            command_interface => $ci,
            nacltask_reboot => 1,
            nacltask_coredump => 1,
        );
    } catch NATE::BaseException with {
        $Log->comment('Ignoring any exception thrown because test is
                    going to fail anyway at later stage.');
    };

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

=head2 free_data_lif

    use NACL::GeneralUtils qw(free_data_lif);

    my $deleted_lif_info = free_data_lif($node,$node->hostrec()->DATA_IP2());

    ## In Cleanup
    if ($deleted_lif_info) {
        NACL::C::NetworkInterface->create(
            %$deleted_lif_info
        );
    }

free_data_lif, can be used to delete an exsiting DATA_IP2 LIF
of a vsim. It returns the deleted lif hashref and expects the user
to recreate the same lif before exting the test.

=cut

sub free_data_lif {
    my ($node,$address) = @_;
    my $lif_obj = NACL::CS::NetworkInterface->fetch(
        command_interface => $node,
        filter            => {address => $address},
        requested_fields  => [
            qw(lif address home-node home-port netmask vserver data-protocol role)
        ],
        allow_empty => 1,
    );

    if ($lif_obj) {
        my $proto = $lif_obj->data_protocol();
        $proto = join(",", @$proto);
        my %lif_recreate = (
            lif               => $lif_obj->lif(),
            address           => $lif_obj->address(),
            'home-node'       => $lif_obj->home_node(),
            'home-port'       => $lif_obj->home_port(),
            netmask           => $lif_obj->netmask(),
            vserver           => $lif_obj->vserver(),
            'data-protocol'   => $proto,
            role              => $lif_obj->role(),
            command_interface => $node,
        );
	try {
            NACL::C::NetworkInterface->delete(
		command_interface => $node,
		vserver           => $lif_obj->vserver(),
		lif               => $lif_obj->lif(),
            );
	} catch NACL::C::Exceptions::NetworkInterface::LifEnabled with {
            NACL::C::NetworkInterface->modify(
                command_interface => $node,
                vserver           => $lif_obj->vserver(),
                lif               => $lif_obj->lif(),
		'status-admin' => 'down',
            );

            NACL::C::NetworkInterface->delete(
                command_interface => $node,
                vserver           => $lif_obj->vserver(),
                lif               => $lif_obj->lif(),
            );
	};
        return \%lif_recreate;
   };
} ## end sub free_data_lif


1;