# $Id$

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

## @summary DFM ComponentState Module
## @author dl-mpo-nacl-dev@netapp.com
## @status shared
## @pod here

=head1 NAME

NACL::CS::ComponentState::DFM

=head1 DESCRIPTION

NACL::CS::ComponentState::DFM is an abstract base class for
DFM "ComponentState" objects at the NACL Component layer. This provides
functionality specific to DFM CS modules. 

Individual CS implementations for DFM elements are expected to be subclasses
of this module. This module, in turn, is a subclass of
L<NACL::CS::ComponentState|lib-NACL-CS-ComponentState-pm>.

=cut

package NACL::CS::ComponentState::DFM;

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 SCALAR ARRAYREF HASHREF OBJECT);
use NACL::ComponentUtils qw(_optional_scalars);
use NATE::Exceptions::Argument qw(:try);
use NACL::Exceptions::InvalidFilterField ();
use NACL::UnitTest::Dfm::Utils::ComponentState;
use Data::Dumper;

use base 'NACL::CS::ComponentState';

use Class::MethodMaker [ scalar =>
        [ { -type => 'NACL::C::DFM::DFMClient' }, 'command_interface', ], ];

=head1 METHODS

=head2 _fetch_dfm_zapi

    # NACL/CS/DFM/Foo.pm
    sub _fetch_zapi {
        my $pkg = shift;
        return $pkg->SUPER::_fetch_dfm_zapi
            (@_,
             api => "foo-list-iter",
             iter_filter => [ qw( attribute1 attribute2 )]
            );
    }

Derived classes that need to implement a DFM ZAPI backend for fetch
can pass control to this base class method to do most of the work.

This routine will only work to drive ZAPI that follow the list
iter ZAPIs which have iter-start, iter-next and iter-end ZAPIs.
The iter-next ZAPIs are assumed to give an output which has an
'foo-info[]' at the second level, which will contain most of
the information.

=over

=item Options

=over

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

(Required, passed in by fetch frontend).  See fetch.  Not used here.

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

(Required, passed in by fetch frontend).  See fetch.

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

Which method on $apiset to call to fetch the data.

=item C<< map => $map >>

(Optional)
This hashref contains key-value pairs where the keys indicate the original
names in the state object as returned by the -iter-zapis and the value
indicates the new field values which also contain the same value as the 
old key. 

E.g: If map => { "old_name1" => "new_name1",
                 "old_name2" => 'new_name2", }
is provided, the state object will have the field name new_name1 along with 
old_name1, containing the same value as 'old_name1' and 'new_name2' along with
old_name2, containing the same value as 'old_name2'. 

=over

=back

=back

=back

=cut

sub _fetch_dfm_zapi {

    $Log->enter() if $may_enter;
    my $pkg = shift;

    my %opts = validate @_, {

        %{ $pkg->_fetch_backend_validate_spec() },

        api                   => { type => SCALAR },
        iter_filter           => { type => ARRAYREF, default => [] },
        extra_iter_filter     => { type => ARRAYREF, default => [] },
        additional_filter_map => { type => HASHREF, default => {} },
        map                   => { type => HASHREF, default => {} },
    };

    my $apiset            = $opts{apiset};
    my $api               = $opts{api};
    my $command_interface = $opts{command_interface};

    my $extra_filter_fields = $pkg->_extra_filter_fields();

    # Additional naming provision
    my %additional_filter_map = %{ $opts{additional_filter_map} };

    # Hash to hold inputs for iter-start ZAPI
    my %start_options;

    if ( @{ $opts{iter_filter} } ) {

       # Copy the fields from those mentioned in iter_filter to %start_options
        $pkg->_hash_copy(
            source => $opts{filter},
            copy   => $opts{iter_filter},
            target => \%start_options,
        );
    }
    if (@$extra_filter_fields) {

        $pkg->_hash_copy(
            source => $opts{filter},
            copy   => $extra_filter_fields,
            target => \%start_options,
        );
    }

    # Hash from 'map' used for renaming
    my %rename_hash = %{ $opts{map} };

    # Variable to hold the state objects
    my @state_objs = ();

    my $output_array
        = $pkg->_get_info_items_from_iter( $apiset, $api, \%start_options );

    # Loop through each *-info item and
    foreach my $info_item ( @{$output_array} ) {

        # Copy of %info_item for iterating
        my %info_item_copy = %{$info_item};

        ## Rename hash (from the "map" input
        for my $old_name ( keys(%rename_hash) ) {

            my $new_name = $rename_hash{$old_name};
            $info_item_copy{$new_name} = $info_item_copy{$old_name};
        }

        my $obj = _create_subtype_objects(
            "command_interface" => $command_interface,
            "package"           => $pkg,
            "item_hash"         => \%info_item_copy
        );

        push @state_objs, $obj;

    } ## end foreach

    $Log->exit() if $may_exit;

    return @state_objs;

} ## end of _fetch_dfm_zapi

###############################################################
# Input: 1. APISet object
#	 2. Name of the api
#        3. Options that the start-iter or stateless iter takes,
# Function: If the name of the api passed as input contains 'iter'
#	(as per current design), it executes -iter-start, -iter-next
#	& -iter-end and returns the *-info[] output of -iter-next.
#	If it is a stateless iter zapi i.e. the api name
# 	passed as input does not contain substring 'iter', then
# 	the -iter zapi will be executed to get all the *-info[]
#	records.
#
# Output: Arrayref containing array of *-info[] records
###############################################################
sub _get_info_items_from_iter {

    my $self = shift;
    my ( $apiset, $api, $start_options ) = validate_pos(
        @_,
        { type => OBJECT, isa => 'NACL::APISet' },
        { type => SCALAR },
        { type => HASHREF },
    );

    # Output to return
    my @output_array = ();

    if ( $api =~ /\-iter$/ ) {

        # The calls for the iter
        my $start_iter = $api . "-start";
        my $next_iter  = $api . "-next";
        my $end_iter   = $api . "-end";

        # Call the iter-* ZAPIs
        my $start_resp    = $apiset->$start_iter( %{$start_options} );
        my $parsed_output = $start_resp->get_parsed_output();

        my $tag  = $parsed_output->[0]->{'tag'};
        my $recs = $parsed_output->[0]->{'records'};

        # If no records found, return empty
        if ( $parsed_output->[0]->{'records'} eq '0' ) {

            $apiset->$end_iter( "tag" => $tag );

            $Log->exit() if $may_exit;

            return \@output_array;
	    
        }

        my $next_resp = $apiset->$next_iter(
            "tag"     => $tag,
            "maximum" => $recs
        );
        $parsed_output = $next_resp->get_parsed_output();

        $apiset->$end_iter( "tag" => $tag );

        # Parse to normalize the output
        my $output = $parsed_output->[0];

        # If there are more than 2 keys in the output of iter-next
        # inform the user and ask to request a library change
        if ( ( keys(%$output) ) > 2 ) {

            NATE::BaseException->throw( "The output of $next_iter "
                    . "has more than two fields in it! The _fetch_dfm_zapi() "
                    . "won't work in such a case. Please raise a BURT against"
                    . " the DFM Nacl team (type=nacl;subtype=nacl_dfm) or mail"
                    . " dl-mpo-nacl-dev\@netapp.com regarding the issue" );

        }

        # Loop through the parsed output
        foreach my $key ( keys( %{$output} ) ) {

            # Check if key is not 'records' and if so,
            # save the *-info[] array into @output_array
            # NOTE: All the iter-next ZAPI outputs have only 2 keys:
            # "records" and "*-info[]".
            if ( $key !~ /^records$/ ) {

                my $temp = $output->{$key}->[0];
                @output_array = @{ $temp->{ ( keys %$temp )[0] } };
                last;

            }
        }

    } else {

        ## Get objects by running -iter zapi continuously
	## until next-tag in the output is empty

        my $stateless_iter = $api . "-iter";
	my $catch = undef;
	while(1) {

	    my $response;
	    try {
		$response = $apiset->$stateless_iter( %{$start_options} );
	    } catch NACL::APISet::Exceptions::ResponseException with {
		my $exception_object = shift;
		$catch = 1;
	    };
	    if( $catch ){
		last;
	    };
	    my $parsed_output = $response->get_parsed_output();

	    # If no records present
	    if( $parsed_output->[0]->{'num-records'} eq '0' ) {
		last;
	    }
            my $records_hashref = $parsed_output->[0]->{'records'}->[0];
            my $info_key_name   = ( keys( %{$records_hashref} ) )[0];
            push( @output_array, @{ $records_hashref->{$info_key_name} } );

	    if( exists $parsed_output->[0]->{'next-tag'} ) {

		$start_options->{'tag'} = $parsed_output->[0]->{'next-tag'};
	    } else {
		last;
	    }
	} # end while(1)

    }    # end if-else $api =~ /-iter/

    return \@output_array;

} ## end _get_info_items_from_iter

sub _create_subtype_objects {

    my (%args) = @_;

    my $command_interface = $args{"command_interface"};
    my $pkg               = $args{"package"};
    my %data_item         = %{ $args{"item_hash"} };

    my $class_name = _determine_filename_from_package($pkg);
    require $class_name;

    # Hold the nested typedefs mapping
    my $nested_typedef_map = $pkg->_nested_objects();

    my $attributes_hashref = $pkg->get_attributes();

    foreach my $key ( keys(%data_item) ) {

        my $original_key = $key;
        $key =~ s/\-/_/g;

        if ( exists $attributes_hashref->{$key} ) {

            my $call_flag = 0;

            my %input_param_hash = (
                "command_interface" => $command_interface,
                "data"              => $data_item{$original_key},
                "key"               => $original_key,
                "context"           => $attributes_hashref->{$key},
            );

            if (   exists $nested_typedef_map->{$key}
                || exists $nested_typedef_map->{$original_key} )
            {

                $input_param_hash{"type"} = $nested_typedef_map->{$key}
                    || $nested_typedef_map->{$original_key};
                $call_flag = 1;
            }
            if ( $attributes_hashref->{$key} !~ /scalar/i ) {

                $call_flag = 1;
            }

            if ($call_flag) {

                $data_item{$original_key}
                    = _set_ocie_fields(%input_param_hash);

            }
        } ## end if exists $attributes_hashref->{$key}

    } ## end foreach
    delete $data_item{"command_interface"};
    my $obj = $pkg->new( command_interface => $command_interface );

    $obj->_set_fields( row => \%data_item );
    delete $obj->{"command_interface"};

    return $obj;
}

sub _set_ocie_fields {

    my (%args) = @_;

    my $cmd_interface = $args{"command_interface"};
    my $key_name      = $args{"key"};
    my $data_info     = $args{"data"};
    my $context       = $args{"context"};
    my $type          = $args{"type"};

    ## If array ##
    if ( $context =~ /array/ ) {

        ## If no elements present ##
        if ( !@{$data_info} || !keys( %{ $data_info->[0] } ) ) {

            # Return an empty array
            my @return_array = ();
            return \@return_array;
        }

        ## If simple ##
        if ( !$type ) {
print "\nIf not type";

            # Check if only one element present or multiple elements
            # Sometimes, when one element present, the array becomes
            # a hash instead. Ref BURT 615406 for details.
            my $type_name_of_key = ( keys %{ $data_info->[0] } )[0];

            if ( ref( $data_info->[0]->{$type_name_of_key} ) eq 'ARRAY' ) {

                return $data_info->[0]->{$type_name_of_key};

            } else {

                # Only one element
                my @return_array = ( $data_info->[0]->{$type_name_of_key} );
                return \@return_array;
            }

        } ## end if undef $type
        else {    ## If belongs to a type

            ## Check if the key name and the typedef name are the same
            ## If same, the elements will be directly present at this level
            my $type_from_key = _convert_to_package_format($key_name);

            my @array_of_items = ();

            if ( $type_from_key eq $type ) {

                @array_of_items = @{$data_info->[0]->{$key_name}};
            } else {

                my $typedef_key = ( keys %{ $data_info->[0] } )[0];
                @array_of_items = @{ $data_info->[0]->{$typedef_key} };

            }

            my @state_objs = ();

            foreach my $item (@array_of_items) {

                my $obj = _create_subtype_objects(
                    "command_interface" => $cmd_interface,
                    "package"           => $type,
                    "item_hash"         => $item,
                );
                push( @state_objs, $obj );
            }

            return \@state_objs;

        } ## end else (if undef $type)

    } ## end if $context =~ /array/
    else {

        if ( defined $type ) {

            ## If no elements present ##
            if ( !@{$data_info} || !keys( %{ $data_info->[0] } ) ) {

                return undef;
            }

            ## Check if the key name and the typedef name are the same
            ## If same, the elements will be directly present at this level
            my $type_from_key = _convert_to_package_format($key_name);

            my $scalar_item;

            if ( $type_from_key eq $type ) {

                $scalar_item = $data_info->[0];

            } else {

                my $typedef_key = ( keys %{ $data_info->[0] } )[0];
                $scalar_item = $data_info->[0]->{$typedef_key}->[0];
            }

            my $obj = _create_subtype_objects(
                "command_interface" => $cmd_interface,
                "package"           => $type,
                "item_hash"         => $scalar_item,
            );

        } ## end if (defined $type)

    } ## end else of( if $context =~ /array/)

}

#################################################################
# This function converts the type given in zapi format
# to a package name.
# E.g, cluster-node-disk-info would become ClusterNodeDiskInfo
#################################################################
sub _convert_to_package_format {

    my $zapi_type = shift;

    my @parts = split( "-", $zapi_type );

    my $return_type = "NACL::CS::DFM::";

    foreach my $char (@parts) {

        $return_type .= ucfirst($char);
    }
    return $return_type;
}

#######################################
# This function determines the file name
# given the package name.
#
# Input: package name
#######################################
sub _determine_filename_from_package {

    my $package_name = shift;
    my $file_name    = $package_name;
    $file_name =~ s/::/\//g;
    $file_name .= '.pm';
    return $file_name;
}

=head2 _apply_filter

    # To be implemented in the DFM CS sub-classes
    # Using Cluster as an example here
    sub _apply_filter {
        $Log->enter() if $may_enter;
        my $pkg = shift;
        $pkg->SUPER::_apply_filter(
            @_,
            main_field      => 'cluster-name-or-id',
            alternate_field => 'cluster-name'
        );
        $Log->exit() if $may_exit;
    }
    
    # Another example, this time for specifying multiple alternate
    # field declarations
    # This is from Event
    sub _apply_filter {
        $Log->enter() if $may_enter;
        my $pkg = shift;
        $pkg->SUPER::_apply_filter(
            @_,
            multiple_field_declarations => [
                {
                    main_field      => 'event-source-name-or-id',
                    alternate_field => 'event-source-name',
                },
                {
                    main_field      => 'event-name-or-id',
                    alternate_field => 'event-name',
                },
            ],
        );
        $Log->exit() if $may_exit;
    }
    
Numerous DFM components have a *-name-or-id field. In the component method
calls the value of this argument can be provided as either the name or
the ID. In the CS object, this field stores the value of either the name
or ID (it cannot store both values). Because of this, filtering could fail
in the case of the *-name-or-id being passed the value not stored.
(Example: the attribute of the CS object stores the ID but we pass the
value of the *-name-or-id field as the name).

To work round this, an overridden implementation of _apply_filter has
been provided for DFM CS modules which allows specifying that the filtering
logic for the *-name-or-id field should be done by looking at the value
of two fields (itself and the field storing the other value).

The example shown above specifies that when attempting to filter on the
"cluster-name-or-id" field, the method should check the value of both
that field as well as "cluster-name". If the value matches either field,
then the CS object has satisfied the filter criteria.

If this method is not overridden, then the default implementation of
_apply_filter is used.

=over

=item Options

=over

=item C<< main_field => $name_or_id_field >>

The name of the *-name-or-id field for which filtering needs to be
done by also looking at an alternate field.

=item C<< alternate_field => $alternate_field >>

The name of the alternate field to look at while filtering.

=item C<< multiple_field_declarations => $array_of_declarations >>

If there are multiple pairs of main_field -> alternate field mappings
that need to be provided, then this argument should be used. The value
should be provided as an array-reference of hash-references, where
each hash-reference should contain the main_field -> alternate_field mapping.
(see the example above)

Note that when this option is provided, then neither C<main_field> nor
C<alternate_field> should be provided.

=back

=back

=cut

sub _apply_filter {
    $Log->enter() if $may_enter;
    my ( $pkg, @args ) = @_;
    my %opts = validate_with(
        params => \@args,
        spec   => {
            _optional_scalars(qw(main_field alternate_field)),
            multiple_field_declarations =>
                { type => ARRAYREF, optional => 1 },
            filter => { type => HASHREF }
        },

        # Allow through other options accepted by SUPER::_apply_filter
        allow_extra => 1
    );

    my $main_field      = delete $opts{main_field};
    my $alternate_field = delete $opts{alternate_field};
    my $multiple_field_declarations
        = delete $opts{multiple_field_declarations};

    my %new_filter = %{ $opts{filter} };

    my $validate_and_modify_filter = sub {
        my ($args) = validate_pos( @_, { type => HASHREF } );

        my $main_field_in_sub      = $args->{main_field};
        my $alternate_field_in_sub = $args->{alternate_field};
        if ( defined($main_field_in_sub) || defined($alternate_field_in_sub) )
        {
            unless ( defined($main_field_in_sub)
                && defined($alternate_field_in_sub) )
            {
                my $defined_field
                    = defined($main_field_in_sub)
                    ? 'main_field'
                    : 'alternate_field';
                $Log->exit() if $may_exit;
                NATE::Exceptions::Argument->throw( 'Internal error: The '
                        . 'implementation of _apply_filter in '
                        . ref($pkg)
                        . "passed only '$defined_field' as argument, (both "
                        . "'main_field' and 'alternate_field' are required)"
                );
            }
            my $filter_field = $opts{filter}->{$main_field_in_sub};
            if ( defined($filter_field) && !$pkg->_is_id($filter_field) ) {
                delete $new_filter{$main_field_in_sub};
                $new_filter{$alternate_field_in_sub} ||= $filter_field;
            }
        }
    };

    if ($multiple_field_declarations) {
        if ( defined($main_field) || defined($alternate_field) ) {
            $Log->exit() if $may_exit;
            NATE::Exceptions::Argument->throw( 'Internal error: When '
                    . "'multiple_field_declarations' is being provided, then "
                    . "neither 'main_field' nor 'alternate_field' should be "
                    . 'specified' );
        }

        foreach my $single_declaration (@$multiple_field_declarations) {
            if ( ref $single_declaration eq 'HASH' ) {
                $validate_and_modify_filter->($single_declaration);
            } else {
                my $ref = ref($single_declaration) || 'scalar';
                $Log->exit() if $may_exit;
                NATE::Exceptions::Argument->throw( 'Internal error: Each of '
                        . "entries in the 'multiple_field_declarations' argument "
                        . "should be a hashref but one of them was a '$ref'"
                );
            }
        }
    } else {
        $validate_and_modify_filter->(
            {   main_field      => $main_field,
                alternate_field => $alternate_field
            }
        );
    }

    # If a filter field is provided as a hash-reference, then that must mean
    # that that field is itself an object, or an array-reference of objects
    # We need to filter on these separately, so move them out of the
    # main filter.
    my %extra_filter;
    while ( my ( $key, $value ) = each %{ $opts{filter} } ) {
        if ( ref $value eq 'HASH' ) {
            $extra_filter{$key} = delete $new_filter{$key};
        }
    }

    # Check if any of the filter keys have "resource-key" as a substring
    # Keys like "resource-key", "group-resource-key" etc
    # will have special characters. Hence we will need to pass the option
    # treat_special_characters_literally => 1  to _apply_filter.
    foreach my $key ( keys(%new_filter) ) {

        if ( $key =~ /resource\-key/ ) {
            $opts{treat_special_characters_literally} = "1";
        }

    }

    # Apply the base class filtering
    $pkg->SUPER::_apply_filter( %opts, filter => \%new_filter );

    # Now let's filter the nested objects. The way it works is that if a
    # field is provided as a hash-reference, then we pass along the value
    # as the filter to the sub-class. For example:
    # filter => { volume
    my $state_objs = $opts{state_objs};

    if ( keys %extra_filter ) {
        my $nested_objects = $pkg->_nested_objects();
        my $matches_filter = sub {
            my ($state_obj)
                = validate_pos( @_, { type => OBJECT, isa => $pkg } );
            while ( my ( $key, $value ) = each %extra_filter ) {

                # If the field has a value, then let's attempt filtering it
                my $isset = "${key}_isset";

                if ( $state_obj->$isset() ) {

                    # Could be either a scalar field (one object) or an array
                    # of objects. Either way, let's just store it in an
                    # array.
                    my @other_cs = $state_obj->$key();

                    # Determine the type of nested object(s). Invoke that
                    # CS package's _apply_filter (since it could be overriden
                    # in that package)
                    my $other_pkg = $nested_objects->{$key};
                    $other_pkg->_apply_filter(
                        state_objs => \@other_cs,
                        filter     => $value
                    );

                    if (@other_cs) {

                        # There were some CS objects that match the filter.
                        # Set only the CS objects that match as the value of
                        # this attribute.
                        $state_obj->$key(@other_cs);
                        return 1;
                    } else {

                        # None of the CS objects match the filter. Reset
                        # the value of this field.
                        my $reset = "${key}_reset";
                        $state_obj->$reset();
                        return 0;
                    }
                }
            }
        };
        @{$state_objs} = grep ( $matches_filter->($_), @{$state_objs} );
    }

    $Log->exit() if $may_exit;

}

# Simple helper to check if the value is an ID (if the value is all-digits
# then it's assumed to be an ID)
sub _is_id {
    $Log->enter() if $may_enter;
    my $pkg = shift;
    my ($name_or_id) = validate_pos( @_, { type => SCALAR } );
    if ( $name_or_id =~ /^\d+$/ ) {
        $Log->exit() if $may_exit;
        return 1;
    } else {
        $Log->exit() if $may_exit;
        return 0;
    }
}

# Overriding the base class _check_data_type_of_filter
sub _check_data_type_of_filter {
    $Log->enter() if $may_enter;
    my ( $pkg, @args ) = @_;
    my %opts = validate_with(
        params      => \@args,
        spec        => { filter => { type => HASHREF } },
        allow_extra => 1
    );
    my %filter         = %{ $opts{filter} };
    my $nested_objects = $pkg->_nested_objects();

    foreach my $key ( keys %$nested_objects ) {
        if ( exists $filter{$key} ) {
            my $filter_value = delete $filter{$key};
            if ( ref $filter_value ne 'HASH' ) {
                my $ref = ref($filter_value) || 'scalar';
                $Log->exit() if $may_exit;
                NATE::Exceptions::Argument->throw( 'The attribute '
                        . "'$key' of '$pkg' contains nested objects, hence "
                        . 'the filter value for this field should have been '
                        . 'provided as a hash-reference, but instead it was '
                        . "provided as a $ref" );
            }
        }
    }

    $pkg->SUPER::_check_data_type_of_filter( %opts, filter => \%filter );
    $Log->exit() if $may_exit;
}

# Default _nested_objects for components
sub _nested_objects {
    return {};
}

1;