# $Id: //depot/prod/test/nacldev/lib/NACL/CS/ComponentState.pm $ # # Copyright (c) 2001-2016 NetApp, Inc., All Rights Reserved # Any use, modification, or distribution is prohibited # without prior written consent from NetApp, Inc. # ## @summary ComponentState Module ## @author dl-nacl-dev@netapp.com ## @status shared ## @pod here =head1 NAME NACL::CS::ComponentState =head1 DESCRIPTION NACL::CS::ComponentState is an abstract base class for "ComponentState" objects at the NACL Component layer. The other significant abstract base class at this layer is NACL::C::Component, for "Component" objects; for every derived class of NACL::CS::ComponentState, there would generally be a corresponding derived class of NACL::C::Component. A ComponentState object represents the response from querying the state/attributes of some kind of thing (called an "element") outside of the perl process. Unlike a Component object's methods, which are supposed to interact with the outside element each time they are called, a ComponentState object's methods after it has been constructed are accessors to past data which has already been fetched (so the answers they return are fast and local and don't change as the element changes) =head1 ATTRIBUTES Each of the derived classes of a ComponentState is expected to provide accessor methods for the individual pieces of data that are part of the state of the corresponding element. In addition to these, all ComponentState objects have a reference to the command_interface used to obtain that CS object. This makes it easier to obtain the component object associated with the CS object (using L). The ComponentState provides an AUTOLOAD method which catches the use of a method with hyphens, replaces the hyphens with underscores, and tries the method again. Thus, any accessor method is accessible in both underscored and hyphenated forms. The "can" method on a ComponentState is also updated to return true when given a hyphenated name for which there is a corresponding underscored name. This allows component implementers not to have to translate from one form to another when passing values to NACL::APISet methods which have the general convention of taking perl options in the style of the underlying element's command syntax, the words within which are often hyphen-separated. =cut package NACL::CS::ComponentState; use strict; use warnings; use feature 'state'; use Scalar::Util qw(blessed); use Params::Validate qw(validate validate_pos validate_with :types); use NATE::Log qw(log_global); my $Log = log_global(); my $may_enter = $Log->may_enter(); my $may_exit = $Log->may_exit(); use NACL::ComponentUtils qw(Dumper); use NATE::BaseException qw(:try); use NACL::Exceptions::InvalidPrivilege; use NATE::Exceptions::Argument; use NACL::APISet::Exceptions::ConnectionFailedException; use NATE::Exceptions::Argument; use NACL::Exceptions::VerifyFailure; use NACL::Exceptions::InvalidFilterField; use NACL::Exceptions::NoElementsFound; use NACL::Exceptions::VerifyCountFailure; use NACL::C::UnitNormalization; use Class::Inspector; use NACL::GeneralUtils qw(_copy_common_component_params _copy_or_move_common_params _copy_common_component_params_with_ci nacl_method_retry); use NACL::Realm; use NACL::APISet::Response::CLI::ParserUtils; # We're using Math::Random::MT::Auto for the random number generation since # we want something that does not clash with Perl's (this implements the # Mersenne Twister algorithm). Reproducibility cannot be guaranteewd if we # use Perl's random number generator since stray calls to srand() (such as # is done on fork for the STask random-name-generator) will affect the # random numbers generated. # This also employs an algorithm superior to that used by Perl and works # on both Windows and *nix. use Math::Random::MT::Auto ':!auto'; use List::Compare; # Turn Params::Validate failures into NATE::Exceptions::Argument BEGIN { Params::Validate::validation_options( on_fail => sub { NATE::Exceptions::Argument->throw(shift); } ); } use Class::MethodMaker [ new => [ '-hash', 'new' ], scalar => [ { -type => 'NACL::C::CommandInterface' }, 'command_interface', ], ]; =head1 METHODS (for component users) =head2 fetch my $widget_state = NACL::CS::Widget->fetch(command_interface=>$ci,...); my @widget_states = NACL::CS::Widget->fetch(command_interface=>$ci,...); (Abstract; almost all derived classes should provide this. Class method). A constructor of sorts, which discovers which elements are present (by interacting with the given command interface). In an array context it creates a component state object for each present element and returns them. In a scalar context it creates a component state object for just one element. (This is analogous to the "find" method in the corresponding component, which takes very similar arguments but constructs components instead of component states. "find" tends to be implemented as a wrapper around "fetch") =over =item Options =over =item C<< command_interface=>$command_interface >> (Usually Required) The NACL::C::CommandInterface that will be used to discover the list of elements. =item C<< filter=>{ attribute1=>$value1, attribute2=>$value2, ... } >> (Optional) A hashref that limits the component states returned to be only those whose attributes have the given values (If possible, the commands/requests sent will be optimized to limit discovery similarly). =item C<< apiset_must=>$ruleset >> (Optional) A hashref constraining which API (mode, interface, etc.) on the given command_interface will be used. See L =item C<< apiset_should=>$ruleset >> (Optional) A hashref suggesting which API (mode, interface, etc.) on the given command_interface is preferred. See L =item C<< allow_empty=>$boolean >> (Optional) If false (the default) then throw an exception if no elements are found. If true, then return undef or an empty list if no elements are found. =item C<< sort_by=>['name1', 'name2', ...] >> (Optional) An array reference containing the names of component state fields based on which a default sorting will take place; others are allowed (but not required) to be undefined. =item C<< requested_fields=>['name1', 'name2', ...] >> (Optional) An array reference containing the names of component state fields that must be filled in; others are allowed (but not required) to be undefined. If the requested_fields option is undef or not given, it is assumed that all component state fields should be filled in. An optimal component state implementation will limit the commands it sends, their verbosity, their columns, etc., when doing so will still fetch the given fields, but simpler component implementations may just ignore this option and always query for all of the state of this element that they can. =item C<< 'method-timeout' => $timeout_in_seconds >> (Optional) We can use this option to specify a large timeout value, which will be used by all command(s) run, in case the command(s) take a long time to run due to large amounts of output. =back =back =head1 METHODS (for component implementors) =head2 _fetch_validate_spec sub fetch { my $pkg = shift; my %opts = validate @_, $pkg->_fetch_validate_spec(); ...; } The Params::Validate spec describing the arguments that all implementations of "fetch" should take. =cut sub _fetch_validate_spec { $Log->enter() if $may_enter; my %fetch_validate_spec; %fetch_validate_spec = ( %{ NACL::C::Component->_common_validate_spec() }, filter => { type => HASHREF, default => {} }, allow_empty => { type => SCALAR, default => 0 }, canned_filters => { type => ARRAYREF, default => [] }, requested_fields => { type => ARRAYREF | UNDEF, default => [] }, # Bit of a hack, to allow for determination of whether to apply # the command line filters or not _ignore_tharn_params => { type => SCALAR, default => 0 }, # Don't assign a default for randomize_order, we do a check for # defined(), so we don't want to wrongly trigger it by assigning # a default randomize_order => { type => BOOLEAN, optional => 1 }, # Allow unknown requested/filter fields to be passed allow_extra => { type => BOOLEAN, default => 0 }, # Allow specification of the node in which to run nodescope commands 'nodescope-node-name' => { type => SCALAR, optional => 1 }, sort_ascending => { type => ARRAYREF, default => [] }, sort_descending => { type => ARRAYREF, default => [] }, sort_by => { type => ARRAYREF, optional => 1, default => [] }, frontend => { type => SCALAR, optional => 1 }, unknown_fields_added_by_backend => {type => SCALAR, default => 0}, show_cmd => { type => SCALAR, optional => 1 }, verify_count => { type => SCALAR, optional => 1 }, ); # extended_query is not applicable for CS delete $fetch_validate_spec{extended_query}; $Log->exit() if $may_exit; return {%fetch_validate_spec}; } ## end sub _fetch_validate_spec =head2 _fetch_backend_validate_spec sub _fetch_mode_interface { my $pkg = shift; my %opts = validate @_, $pkg->_fetch_backend_validate_spec; ...; } The Params::Validate spec describing the arguments available in the backend implementations for "fetch". These should include command_interface, apiset, requested_fields and filter. =cut sub _fetch_backend_validate_spec { $Log->enter() if $may_enter; my %fetch_backend_validate_spec; my $var; %fetch_backend_validate_spec = ( %{ NACL::C::Component->_backend_validate_spec() }, requested_fields => { type => ARRAYREF | UNDEF, default => [] }, filter => { type => HASHREF | UNDEF, default => {} }, _apply_filter => { type => SCALARREF, default => \$var }, # Allow specification of the node in which to run nodescope commands 'nodescope-node-name' => { type => SCALAR, optional => 1 }, 'show_cmd' => { type => SCALAR, optional => 1 }, verify_count => { type => SCALAR, optional => 1 }, sort_by => { type => ARRAYREF, default => [] , optional => 1 }, ); $Log->exit() if $may_exit; return {%fetch_backend_validate_spec}; } ## end sub _fetch_backend_validate_spec =head2 call_on_apiset sub my_method { my $pkg_or_obj = shift; $pkg_or_obj->call_on_apiset(@_, choices => [...]); } A helper for constructing public "front end" methods of components which are mode- or interface-agnostic. See L =cut use NACL::ChooseAPISet qw(call_on_apiset); =head2 _hash_move A helper to select and rename subsets of options (to help in calling API layer methods). See L =head2 _optional_scalars # same as (a=>{type=>SCALAR,optional=>1}, b=>{type=>SCALAR, optional=>1}) _optional_scalars(qw(a b)) A compact way to represent the Params::Validate spec needed for most of the options to most component methods, which tend to be optional strings ('SCALAR' in Params::Validate). See L =head2 AUTOLOAD sub a_b_c { ... } my $name = "a-b-c"; my $result = $self->$name(); # works The component state package has an AUTOLOAD method so that any attribute declared as "a_b_c" can be accessed using either method name "a-b-c" or "a_b_c". =cut use NACL::ComponentUtils qw(_hash_move _hash_copy _zapi_hash_copy _optional_scalars AUTOLOAD can _process_options convert_to_system_time convert_to_unix_time enumerate_month enumerate_week _translate_to_obj_field_name _can_validate_pos_spec get_package_name _can_validation _make_attribute_readonly ); =head2 format_for_log This method will be called as a side effect of calling something like: $Tharn::Log->debug($component_state) It causes the log system to write a perl dump of the string representation of the component state's attributes (computing this string only if debug log level is enabled) =cut use NACL::ComponentUtils qw(_dump_one); sub format_for_log { my ($self) = @_; return _dump_one($self); } =head2 _apply_filter sub fetch { my $pkg = shift; ... my @state_objs = $pkg->call_on_apiset(...); $pkg->_apply_filter( state_objs => \@state_objs, filter => $filter, [ treat_special_characters_literally => 0 | 1, ] # default: 0 [ return_on_mismatch => 0 | 1 ] # default: 1 ); ... } This method filters the state objects based on the filter provided through the C argument. This method is capable of handling the following: =over =item Unit normalization This method can handle mismatches in the unit type. For example, if the value of a field is "1024M" and the filter provided is "1GB", then this does the appropriate conversions and understands that the values match. =item Special characters Special characters such as * ("abc*" matches abc followed by anything), | ("ab|bc" will match if the value is "ab" or "bc"), ! ("!ab" will match if the value is not "ab") along with relational characters (>, <, >=, <=) are also understood and handled accordingly. (Note that special characters can be treated literally if C is set) =back This method either updates the reference to be for the state objects that matched the filter (if C is 1: this is the default behavior), or it constructs and throws a C exception (if C is 0). =over =item Options =over =item C<< state_objs => \@state_objs >> (Required) Reference to the state objects to be filtered. Note that this updates the reference directly. Take as example: # Let's assume we get 4 state objects my @state_objs = $pkg->call_on_apiset(...); # Assume that only objects 1 and 3 match the filter $pkg->_apply_filter( state_objs => \@state_objs, filter => $filter ); # From this point onwards, @state_objs will be only the two # state objects that matched the filter =item C<< filter => \%filter >> (Required) The filter hash-reference. =item C<< treat_special_characters_literally => 0 | 1 >> (Optional, defaults to 0) If 0, then special characters are handled with the special semantics mentioned above. If 1, then special characters are treated literally (for example, a filter of "ab*" is not considered to be "ab" followed by any characters, but is instead considered as the literal string "ab*") =item C<< return_on_mismatch => 0 | 1 >> (Optional, defaults to 1) If 1, then return all the objects that matched the filter (i.e. don't throw an exception for those that did not match). If 0, throw a C if there are mismatches between the any of the filter values and the values present in the CS object. =back =back =cut sub _apply_filter { $Log->enter() if $may_enter; my ( $pkg, @args ) = @_; my %opts = validate @args, { state_objs => { type => ARRAYREF }, filter => { type => HASHREF }, treat_special_characters_literally => { type => SCALAR, default => 0 }, return_on_mismatch => { type => SCALAR, default => 1 }, }; my $filter = $opts{filter}; my $state_objs = $opts{state_objs}; my $do_not_delete_filter = $opts{treat_special_characters_literally}; my $return_on_mismatch = $opts{return_on_mismatch}; my $deleted_filter; my $msg; my $hashref = {}; my %filter_copy = %$filter; # Make a call to _process_options to turn objects into scalars $pkg->_process_options(options => \%filter_copy); my $extra_fields = $pkg->_extra_filter_fields(); foreach my $extra_field (@$extra_fields) { delete $filter_copy{$extra_field}; } # CMode CLI accepts regular expressions and the CLI automatically applies # the required filters to the output. Hence we do not have to use this in # case of filters containing regular expressions. $deleted_filter = $pkg->_remove_relational_regex_filters( filter => \%filter_copy ) if ( !$do_not_delete_filter ); if ( keys %filter_copy ) { my $matches_filter = sub { my ($state_obj) = @_; foreach my $field ( keys %filter_copy ) { my $expected_value = $filter_copy{$field}; my $original_expected_value = $expected_value; # Nothing to do if the filter field is undef next if ( !defined $expected_value ); my $obtained_value = $state_obj->$field(); my $original_obtained_value = $obtained_value; # Update the verification failure string. This string is # updated for verify_fields and contains the description of # which fields mismatched. my $update_verification_failure_str = sub { $pkg->_update_verification_failure_str_and_hash( msg_ref => \$msg, hashref => $hashref, field => $field, expected_value => $original_expected_value, obtained_value => $original_obtained_value ); }; try { NACL::C::UnitNormalization::guess_unit($obtained_value); $obtained_value = NACL::C::UnitNormalization::to_bytes( $obtained_value); $expected_value = NACL::C::UnitNormalization::to_bytes( $expected_value); } catch NATE::Exceptions::Argument with {}; if (ref $obtained_value eq 'ARRAY' && @$obtained_value) { my %temp; foreach my $state_field_entry ( @{$obtained_value} ) { $temp{ lc($state_field_entry) } = 1; } foreach my $filter_field_entry ( @{$expected_value} ) { if ( !$temp{ lc($filter_field_entry) } ) { if ($return_on_mismatch) { return 0; } else { $update_verification_failure_str->(); } } } } elsif (ref $expected_value eq 'Regexp') { if ($obtained_value !~ $expected_value) { if ($return_on_mismatch) { return 0; } else { $update_verification_failure_str->(); } } } else { if ( defined($obtained_value) && ( lc($obtained_value) ne lc($expected_value) ) ) { if ($return_on_mismatch) { return 0; } else { $update_verification_failure_str->(); } } } } return 1; }; @{$state_objs} = grep( $matches_filter->($_), @{$state_objs} ); } @{$state_objs} = $pkg->_apply_relational_regex_filters( state_objs => $state_objs, filter => $deleted_filter, msg_ref => \$msg, hashref => $hashref, return_on_mismatch => $return_on_mismatch ) if ( keys %$deleted_filter ); if ( defined $msg ) { # This will be populated only if return_on_mismatch=0 and there # is some mismatch $Log->exit() if $may_exit; $pkg->_throw_verification_failure( message => $msg, hashref => $hashref ); } $Log->exit() if $may_exit; return @{$state_objs}; } =head2 _check_for_invalid_requested_fields B. Use L<_check_for_invalid_requested_filter_fields|lib-NACL-C-Component-pm/_check_for_invalid_requested_filter_fields> instead. sub fetch { ... my @state_objs = $pkg->call_on_apiset(...); $pkg->_apply_invalid_requested_fields( state_objs => \@state_objs, requested_fields => $opts{requested_fields} ); ... } This method is used (in the 'fetch' frontend) to determine whether all of the fields specified by 'requested_fields' could be filled into the ComponentState object. If an invalid field was requested for, a "NACL::Exceptions::InvalidFilter" exception is thrown. If the field requested for is valid but could not be filled in for that mode or interface then we do not throw an exception but simply log that that field could not be filled in. =cut sub _check_for_invalid_requested_fields { $Log->enter() if $may_enter; $Log->warn( '_check_for_invalid_requested_fields is deprecated. ' . 'Please use _check_for_invalid_requested_filter_fields instead' ); my $pkg = shift; my %opts = validate @_, { requested_fields => { type => ARRAYREF | UNDEF }, state_objs => { type => ARRAYREF | UNDEF }, }; $Log->debug( "Dumper of opts in '_check_for_invalid_requested_fields':\n" . NACL::ComponentUtils::Dumper( \%opts ) ); my $new_requested_fields = $opts{requested_fields}; my $state_objs = $opts{state_objs}; unless ( @{$state_objs} ) { $Log->debug('No state objects'); $Log->exit() if $may_exit; return; } unless ($new_requested_fields) { $Log->debug("'requested_fields' empty"); $Log->exit() if $may_exit; return; } my $state_obj = $state_objs->[0]; foreach my $requested_field (@$new_requested_fields) { my $defined; try { $defined = defined $state_obj->$requested_field(); } otherwise { $Log->exit() if $may_exit; NACL::Exceptions::InvalidFilterField->throw( "Unknown requested field '$requested_field'. This could be " . "because:\n" . "\t1. The field '$requested_field' is invalid\n" . "\t2. The field '$requested_field' is valid but has " . "not been implemented on the CS object '$pkg'. If " . 'this is the case, please raise a burt against ' . 'nacl (type=nacl;subtype=nacl_core) or mail ' . 'dl-nacl-dev@netapp.com regarding the issue' ); }; unless ($defined) { # Accessor exists for this field, hence is valid. # It is just not applicable for this mode/interface $Log->debug( "Requested field '$requested_field' could " . 'not be filled for this mode or interface' ); } } $Log->exit() if $may_exit; return; } =head2 _set_fields sub _fetch_mode_interface { # Invoke API, get parsed output, retrieve appropriate fields ... # %state_fields contains the fields and values to be set in # the state object $state_obj->_set_fields( row => \%state_fields ); ... } This method is a generic implementation of setting fields in a state object. Provided a state object and a reference to a hash containing field-value pairs, it sets those fields which are defined in the Class::MethodMaker definition of that ComponentState module. (takes care of setting scalars and array fields appropriately) It also takes care of fields starting with a digit. If a field begins with a digit, the corresponding accessor method would also start with a digit, but perl does not allow this. The convention we've settled on is for such fields to have a leading underscore. This method ensures that for fields starting with a digit, the field filled into the state object has a leading underscore. =cut # Keyed by package name. Contains all the keys that have attempted to be # set through _set_fields but which have not been defined in MethodMaker. # The intent of this hash is so that the warning is emitted only once per field, # rather than for every single call to _set_fields. my %Set_Invalid_Fields; sub _is_invalid_set_field_cached { my ($pkg, $field) = @_; return exists $Set_Invalid_Fields{$field}; } sub _set_invalid_set_field_cache { my ($pkg, $field) = @_; $Set_Invalid_Fields{$field} = 1; } sub _set_fields { my ($self, @args) = @_; state $spec = { row => {type => HASHREF}, # ZAPI requires special processing for empty array-of-hashref fields. # CLI back-ends can set this to 0 # to skip over this processing. It is not mandatory for CLI back-ends # to set this to 0, but setting it to 0 will improve performance. is_zapi => {type => SCALAR, default => 1}, # Add to MethodMaker fields present in "row" but not currently # defined in MethodMaker. add_unknown_fields => {type => SCALAR, default => 0}, # Quoting of values might be needed (see # NACL::CS::ComponentState::ONTAP::_needs_to_be_quoted()) for CMode. # This can be used to skip over the call to _needs_to_be_quoted(). # Again, sending this in is not mandatory, but passing it in as 0 # will allow skipping over the call. need_to_quote => {type => SCALAR, optional => 1}, api => {type => SCALAR, optional => 1}, suppress_type_warning => {type => SCALAR, default => 0}, }; my %opts = validate @args, $spec; my $row = $opts{row}; my $is_zapi = $opts{is_zapi}; # _needs_to_be_quoted() does multiple regex checks, so calling it # for every field of every object adds time. Let's determine if making # the call is even needed, so we can skip the regex checks. my $need_to_check_quoting = $opts{need_to_quote} // $self->_need_to_check_quoting(); my $pkg = $self->get_package_name(); my $set_one_field = sub { my ($key, $value) = @_; # If the field of output is "fetch", then turn it into "c_fetch" # since that's what the attribute is named. # Note that we need two separate variables: one for what the # CS attribute is named ($new_key) and another for what the field # of output is ($key). The field of output is used to lookup # the compatibility hash and then if we use _determine_command_details # to determine details of $key. my $new_key = $key; $new_key = 'c_fetch' if ( $key eq 'fetch' ); if (ref $value eq 'ARRAY') { # The parsed output for fields whose value is "" in ZAPI # is [ {} ]. We need to handle this case specially, because # otherwise it assumes this field to be an array field and # sets its value to be {}. This has been noticed for qtrees, # are there any other command sets for which this is noticed? # Check if there's one entry in the array, which is an empty # hashref (i.e. type hashref, contains no keys) if ( $is_zapi && ( @$value == 1 ) && ( ref $value->[0] eq 'HASH' ) && ( !keys %{ $value->[0] } ) ) { $self->$new_key('""'); } else { if (ref ($self->$new_key()) eq 'ARRAY') { # For ZAPI, values with special characters are not # within quotes. Put them within quotes to align with # the CLI standard my @values; if ($need_to_check_quoting) { foreach my $val (@$value) { if ($self->_needs_to_be_quoted(value => $val)) { $val = '"' . $val . '"'; } push @values, $val; } } else { @values = @$value; } $self->$new_key(@values); } else { # Field is defined in the CS object as a scalar but was # returned as an array. # Determine whether this is because the field definition in # the CS file is wrong or whether it's because the APISet # returned the parsed output for this field to be # an array instead of a scalar if ($opts{suppress_type_warning}) { # Just set the value as-is and don't log the warning $self->$new_key($value); } else { $self->_reconcile_scalar_array_mismatch( api => $opts{api}, key => $key, value => $value ); } } } } else { # For ZAPI, values with special characters are not within # quotes. Put them within quotes to align with the CLI standard if ($need_to_check_quoting && $self->_needs_to_be_quoted(value => $value)) { $value = '"' . $value . '"'; } $self->$new_key($value); } }; while ( my ( $key, $value ) = each %{$row} ) { # Instead of checking if the method exists with can(), let's just invoke # the method and then catch an InvalidMethod exception if the method # doesn't exist. This would happen only if an incorrect mapping was # specified in the CS back-end, or if some fields of output are not # stored in the CS object. if ( ref ($self) =~ /NACL::CS::Client::ONTAPSelectDeploy/g ) { $key = to_key_name( item => $key ); } try { $set_one_field->($key, $value); } catch NACL::Exceptions::InvalidMethod with { my $exception = $_[0]; my $invalid_field = $exception->method(); if ($opts{add_unknown_fields}) { if ( ref ($self) =~ /NACL::CS::Client::ONTAPSelectDeploy/g && !defined $value ) { return; } else { $pkg->_install_methodmaker_field(field => $key, value => $value); $set_one_field->($key, $value); } } elsif (!$pkg->_is_invalid_set_field_cached($invalid_field)) { $Log->warn("Attempt was made to set field '$invalid_field' " . "on package '$pkg', but this field is not defined in " . 'Class::MethodMaker. Please raise a burt against nacl ' . '(type=nacl;subtype=nacl_core) or mail ' . 'dl-nacl-dev@netapp.com regarding the issue'); $pkg->_set_invalid_set_field_cache($invalid_field); } }; } return; } # Sub-class will define implementation. sub _reconcile_scalar_array_mismatch {} sub _install_methodmaker_field { $Log->enter() if $may_enter; my ($pkg, @args) = @_; state $spec = { field => {type => SCALAR}, type => {type => SCALAR, optional => 1}, value => {optional => 1}, }; my %opts = validate_with( params => \@args, spec => $spec, ); my $type = $opts{type}; if (!defined $type) { if (defined $opts{value}) { if (ref $opts{value} eq 'ARRAY') { $type = 'array'; } else { $type = 'scalar'; } } else { $Log->exit() if $may_exit; NATE::Exceptions::Argument->throw("Either 'type' or 'value' " . 'should be passed in the call to _install_methodmaker_field'); } } my $method = $pkg->_translate_to_obj_field_name($opts{field}); Class::MethodMaker->import(['-target_class' => $pkg, $type => $method]); $Log->exit() if $may_exit; } =head2 _fetch_snmp # NACL/CS/Foo.pm sub _fetch_snmp { my $pkg = shift; return $pkg->SUPER::_fetch_snmp (@_, api => "snmp_walk", map => { component_state_field1 => "snmp-field1", component_state_field2 => "snmp-field2" }, [ copy => [ qw(component_state_field4) ], ] ); } Derived classes that need to implement an SNMP backend for fetch can pass control to this base class method to do most of the work. =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<< requested_fields=>$requested_fields >> (Required, passed in by fetch frontend). See fetch. These settings will be used as the "requested-columns", to the snmp_walk() api call =item C<< filter=>$filter >> (Required, passed in by fetch frontend). See fetch. These settings will be used as the "filter" for get_matching_objects() api call =item C<< api=>$apiset_method >> Which method on $apiset to call to fetch the data. If the filter field is defined the api method being invoked is get_matching_object() . If the filter is not defined then the api method snmp_walk() is invoked . =item C<< map=>$map >> (Optional, at least one of map or copy should be provided) A hashref mapping from the component state attribute names for this component (which are conventionally the same as the C-mode CLI column names, so we call these "cli" fields here) into the names used in the relevant type in the SNMP call. This mapping is used to map "required_fields" and "filter" options into "requested_columns" and "filter" inputs to snmp_walk and get_matching_objects, and then the reverse mapping is also used to map snmp hashref data into component state names. =item C<< copy => $copy >> (Optional, at least one of copy or map should be specified) This arrayref specifies that all the fields specified in it have the same name in the SNMP call. For example, providing copy => [ qw(a) ] is equivalent to doing map => { a => ['a'] } =back =back =cut sub _fetch_snmp { $Log->enter() if $may_enter; my $pkg = shift; my %opts = validate @_, { %{ $pkg->_fetch_backend_validate_spec() }, baseoid => { type => SCALAR }, api => { type => SCALAR, default => 'snmp_walk' }, map => { type => HASHREF, default => {} }, copy => { type => ARRAYREF, default => [] }, }; my $apiset = $opts{apiset}; my $api = $opts{api}; my $command_interface = $opts{command_interface}; my $filter = $opts{filter}; my $api_opts = { baseoid => $opts{baseoid} }; my $requested_fields = $opts{requested_fields}; ##List of parameters to be mapped from cli form to snmp form my @cli_to_snmp = %{ $opts{map} }; # copy => [ qw(a b) ] is equivalent to doing map => {a => ['a'], b => ['b']} # For each element in copy, we make an entry of this form foreach ( @{ $opts{copy} } ) { push @cli_to_snmp, ( $_ => [$_] ); } $Log->debug( sub { "Dumping output of cli-to-snmp " . Dumper( \@cli_to_snmp ) } ); my ( $query, $output, @snmp_to_cli ); ## The parsed output of snmp has 2 levels to access the ## actual value of any field - $output->vserverType->value ## ## 'vserverType' => { ## 'asn1_class_tag' => '2(INTEGER)', ## 'descriptive_name' => 'NETAPP-MIB::vserverType.4294967295', ## 'value' => 'admin', ## 'raw_value' => 1, ## 'object_name' => 'vserverType', ## 'numericOID' => '1.3.6.1.4.1.789.1.27.1.1.15.4294967295', ## 'instance' => '4294967295' ## }, ## ## 'vserverSnapshotPolicy' => { ## 'asn1_class_tag' => '4(OCTET STRING)', ## 'descriptive_name' => 'NETAPP-MIB::vserverSnapshotPolicy.4294967295', ## 'value' => 'none', ## 'raw_value' => 'none', ## 'object_name' => 'vserverSnapshotPolicy', ## 'numericOID' => '1.3.6.1.4.1.789.1.27.1.1.11.4294967295', ## 'instance' => '4294967295' ## }, ## ## map in the fetch() frontend is passed in like this ## ## $map = { ## "vserver" => 'vserverName', ## "type" => 'vserverType', ## "uuid" => 'vserverUuid', ## "rootvolume" => 'vserverRootVolume', ## "aggregate" => 'vserverAggregate', ## "vol-count" => 'vserverNumVolumes', ## }; ## ## After processing the map/copy options, cli_to_snmp array ## has entries in the following form ## [ 'aggr-list', ## 'vserverAggrList', ## 'quota-policy', ## 'vserverQuotaPolicy', ## ] ## ## We need a mapping of this form ## ## [ ## [ ## 'vserverType', ## 'value' ## ], ## 'type', ## [ ## 'vserverSnapshotPolicy', ## 'value' ## ], ## 'snapshot-policy', ## [ ## 'vserverComment', ## 'value' ## ], ## 'comment', ## ] ## ## To extract the values from parsed output of snmp (mentioned above) ## and to associate to the respective cli field. ## ## The following code snippet does the same!! ## Take the original array @cli_to_snmp and push snmp 'values' ## to each value of the key value pair thus converting the value ## from scalar to an anonymous array. ## Finally reverse this @tmp_snmp_to_cli to get the ## snmp_to_cli array. This will be used to pass to the map option of ## _zapi_hash_copy my %tmp_snmp_to_cli = @cli_to_snmp; foreach my $key ( keys %tmp_snmp_to_cli ) { my @array = (); ## Eg. @array = ('vserverAggrList','value'); @array = ( $tmp_snmp_to_cli{$key}, 'value' ); $tmp_snmp_to_cli{$key} = \@array; } my @tmp_snmp_to_cli = %tmp_snmp_to_cli; @snmp_to_cli = reverse @tmp_snmp_to_cli; $Log->debug( sub { "Dumping output of snmp-to-cli " . Dumper( \@snmp_to_cli ) } ); ## Handle when filter option is being passed here if ( $filter && %{$filter} ) { my $obj = $pkg->new( command_interface => $command_interface ); my %local_filter = %$filter; foreach my $element ( keys %local_filter ) { if ( ref $obj->$element() eq 'ARRAY' ) { my $data = $local_filter{$element}; my $actual_data = join( ",", @$data ); $local_filter{$element} = $actual_data; } ## if ref $obj ends here } ##foreach $element ends here $query = $pkg->_zapi_hash_copy( source => \%local_filter, map => \@cli_to_snmp ); $api = 'get_matching_objects'; } ## if $filter ends here my ( $snmp_requested_fields, $key, $response, @state_objs, %final_args ); $Log->debug( sub { " The filter being passed " . Dumper($query) } ); ##The final argument %final_args = %{$api_opts}; ##Adding filter here if defined if ( defined $query ) { %final_args = ( %final_args, %$query ); } ## Handle when requested_fields option is being passed here if ( $requested_fields && @{$requested_fields} ) { $snmp_requested_fields = $pkg->_zapi_hash_copy( source => { map { $_ => '' } @{$requested_fields} }, map => \@cli_to_snmp ); $Log->debug( sub { " This is snmp-req-field " . Dumper($snmp_requested_fields); } ); $key = [ keys %{$snmp_requested_fields} ]; } # end if $requested_fields && @{ $requested_fields } ends here ##Adding requested_columns here if it is defined if ( defined $key ) { if ( $api eq 'get_matching_objects' ) { ##get_matching_objects will handle the requested_columns here %final_args = ( %final_args, requested_columns => $key ); } else { ## If the api is snmp_walk and the requested_field is defined @state_objs = $pkg->_snmp_walk_with_requested_columns( command_interface => $command_interface, apiset => $apiset, 'snmp_to_cli' => \@snmp_to_cli, 'requested_fields' => $key ); $Log->exit() if $may_exit; return @state_objs; } ##end else } ##defined $key $Log->debug( sub { " The Final Args to the Api call " . Dumper( \%final_args ) } ); $Log->debug( sub {" The Api being invoked is $api "} ); ##Invoke the api here $response = $apiset->$api(%final_args); if ( $query && %{$query} ) { ## If query is given the output directly contains the parsed one $output = $response; } else { ## if snmp_walk was involked, then it returns the response object. ## So call the get_parsed_output on the response object $output = $response->get_parsed_output(); } $Log->debug( sub { " Parsed output of Api call " . Dumper($output) } ); foreach my $record ( @{$output} ) { my $row = $pkg->_zapi_hash_copy( source => $record, map => \@snmp_to_cli ); my $obj = $pkg->new( command_interface => $command_interface ); foreach my $key ( keys %$row ) { if ( ref $obj->$key() eq 'ARRAY' ) { my @array_eq = split( ',', $row->{$key} ); $row->{$key} = \@array_eq; } } $obj->_set_fields( row => $row ); push @state_objs, $obj; } $Log->exit() if $may_exit; return @state_objs; } ## end sub _fetch_snmp =head2 _snmp_walk_with_requested_columns sub _fetch_cmode_snmp { ... $pkg->_snmp_walk_with_requested_columns( command_interface => $opts{command_interface}, apiset => $opts{apiset}, 'snmp_to_cli' => \@snmp_to_cli, 'requested_fields' => \@list_of_requested_columns ); ... $apiset->snmp_walk(...); ... } This method is used to invoke snmp walk with a number of requested_fields . It builds the component state objects by combining the rows returned for each column specified in the requested_fields =over =item Options =over =item C<< command_interface => $command_interface >> (Mandatory) The command interface to be used for invoking the snmp walk =item C<< apiset => $apiset >> (Optional) The apiset chosen for this invocation. =item C<< requested_fields => 'requested_fields' >> (Mandatory) The requested_fields parameter with column names as in respective SNMP table. =item C<< snmp_to_cli => $snmp_to_cli >> (Mandatory) Reference to an array containing mapping from snmp field names to CS cli field names =back =back =cut sub _snmp_walk_with_requested_columns { $Log->enter() if $may_enter; my $pkg = shift; my %opts = @_; my $command_interface = $opts{'command_interface'}; my $apiset = $opts{'apiset'}; my $api = 'snmp_walk'; ##snmp_to_cli contains mapping of snmp field name to the corresponding ##cli field name my $snmp_to_cli = $opts{'snmp_to_cli'}; ## $key is a reference to a list of requested_fields from a SNMP table my $key = $opts{'requested_fields'}; my (%list_of_values, $response, @parsed_responses, @field_values, @state_objs ); ##Doing snmp walk for each column given in the $key foreach my $column ( @{$key} ) { @parsed_responses = (); $Log->debug( sub {"The api being invoked $api"} ); $response = $apiset->$api( baseoid => $column ); @parsed_responses = @{ $response->get_parsed_output() }; @{ $list_of_values{$column} } = @parsed_responses; } ##SNMP walk is completed for the columns my $num_of_objs = @parsed_responses; foreach my $i ( 0 ... $num_of_objs - 1 ) { $state_objs[$i] = $pkg->new( command_interface => $command_interface ); } foreach my $record ( keys %list_of_values ) { my @values_fetched = @{ $list_of_values{$record} }; foreach my $i ( 0 ... $num_of_objs - 1 ) { my $row = $pkg->_zapi_hash_copy( source => $values_fetched[$i], map => $snmp_to_cli ); foreach my $key ( keys %$row ) { if ( ref $state_objs[$i]->$key() eq 'ARRAY' ) { my @array_eq = split( ',', $row->{$key} ); $row->{$key} = \@array_eq; } } $state_objs[$i]->_set_fields( row => $row ); } ##foreach my $i (0...$num_of_objs-1) } ##foreach my $record ( keys %list_of_values ) $Log->exit() if $may_exit; return @state_objs; } ## end sub _snmp_walk_with_requested_columns =head2 _want_any_field_of # NACL/CS/Foo.pm sub _fetch_mode_interface { my $pkg = shift; ... # Here's an example of conditionally invoking an API # based on the fields required in the state object my $api = 'foo_status'; my @fields_filled_by_foo_status = ( 'foo1', 'foo2' ); if ($pkg->_want_any_field_of( requested_fields => $requested_fields, filter => $filter, fields_filled_by_api => \@fields_filled_by_foo_status, ) ) { # Invoke the API which fills in these fields # Populate the state object(s) with these fields } ... # Here's an example of conditionally invoking an API in verbose mode # based on the fields required in the state object. my $api = 'bar_status'; my %api_opts; my @fields_filled_only_in_verbose = ( 'bar5', 'bar6' ); if ($pkg->_want_any_field_of( requested_fields => $requested_fields, filter => $filter, fields_filled_by_api => \@fields_filled_only_in_verbose, ) ) { $api_opts{verbose} = 'true'; } $apiset->$api(%api_opts); ... } (For component developers only) This method checks the fields of the ComponentState object that would get filled in by the API call against the fields that need to be filled into the ComponentState object (this would be the union of the fields requested for through requested_fields and the fields present in the filter) and returns 1 if any of the fields filled by the API is required to be filled into the state object. It returns 0 if none of the fields filled by the API are required to be filled into the ComponentState object. This method can be used for two purposes: * To determine whether an API needs to be invoked or not (if the fields that the API would fill into the object are not required then the API need not be invoked) For example, if the filter is { 'a' => 1 } and requested_fields is ['b', 'c'] (therefore, the fields required to be filled into the state object are 'a', 'b' and 'c') and the API 'foo' fills in fields 'd' and 'e', then 'foo' need not be invoked. However, if API 'bar' fills in fields 'a' and 'd', then it needs to be invoked. * To determine whether an API needs to be invoked in verbose mode. Certain commands have an option to display output in verbose mode, i.e. show extra details which wouldn't normally be displayed. If any of the fields shown only in verbose are required to be filled into the state object, then the API needs to be invoked in verbose mode. =over =item Options =over =item C<< requested_fields => $requested_fields >> (Required, ARRAYREF) The requested_fields parameter passed to state/fetch. =item C<< filter => $filter >> (Required, HASHREF) The filter parameter passed to find/fetch. =item C<< fields_filled_by_api => [ $field1, $field2, ...] >> (Required, ARRAYREF) The fields of the ComponentState object that would get filled in by the API call. (or the fields that would get filled in by the API call in verbose mode, depending on the context in which this method is invoked) =back =back =cut sub _want_any_field_of { $Log->enter() if $may_enter; my $pkg = shift; my %opts = validate( @_, { requested_fields => { type => ARRAYREF | UNDEF }, filter => { type => HASHREF }, fields_filled_by_api => { type => ARRAYREF }, } ); my $requested_fields = $opts{requested_fields}; my $filter = $opts{filter}; my $fields_filled_by_api = $opts{fields_filled_by_api}; my $contains_any_fields = sub { # The union of requested_fields and the filter are the fields required # in the state object. my @keys_of_filter = keys %{$filter}; my @all_fields = @keys_of_filter; if ( $pkg->_want_some_fields($requested_fields) ) { @all_fields = ( @all_fields, @{$requested_fields} ); } # @all_fields could have duplicates, the section of code below is for # removing duplicates my %fields_required_hash; foreach my $each_field (@all_fields) { $fields_required_hash{$each_field} = 1; } my @fields_required_in_state_object = keys %fields_required_hash; $Log->debug( "Fields required in state object:\n" . Dumper \@fields_required_in_state_object ); $Log->debug( "Fields filled by API:\n" . Dumper $fields_filled_by_api); my %fields_filled_by_api_hash; foreach my $each_api_field ( @{$fields_filled_by_api} ) { $fields_filled_by_api_hash{$each_api_field} = 1; } foreach my $required_field (@fields_required_in_state_object) { # Check if any of the required fields is filled in by the API if ( exists $fields_filled_by_api_hash{$required_field} ) { return 1; } } return 0; }; if ( $pkg->_want_all_fields($requested_fields) or ( $contains_any_fields->() ) ) { $Log->exit() if $may_exit; return 1; } else { $Log->exit() if $may_exit; return 0; } } # Similar to _want_any_field_of, but returns true only if requested_fields # is explicitly passed. sub _explicitly_want_any_field_of { $Log->enter() if $may_enter; my ($pkg, @args) = @_; my %opts = validate_with( params => \@args, spec => { requested_fields => { type => ARRAYREF } }, allow_extra => 1 ); my $ret = 0; # requested_fields is specified (i.e. is not the default of []) if (@{$opts{requested_fields}}) { $ret = $pkg->_want_any_field_of(%opts); } $Log->exit() if $may_exit; return $ret; } sub _are_fields_present_in_req_or_filter { $Log->enter() if $may_enter; my ( $pkg, %opts ) = @_; $opts{fields_filled_by_api} = delete $opts{fields}; my $ret_val = $pkg->_want_any_field_of(%opts); $Log->exit() if $may_exit; return $ret_val; } =head2 _set_to_test_priv B The APISet automatically sets to the highest privilege level possible, so this method is no longer needed. It has been left untouched for backwards compatibility, but it should no longer be needed. # NACL/CS/Foo.pm sub fetch { my $pkg = shift; ... $pkg->_set_to_test_priv( requested_fields => $requested_fields, filter => $filter, test_fields => [ $test_field1, $test_field2, ... ], apiset => $apiset, api_opts => \%api_opts ); ... $apiset->api_to_invoke(%api_opts); ... } (For component developers only) This method checks whether any of the fields which are accessible only in test privilege have been provided in either of requested_fields or filter, and if so attempts to set to test privilege. However, if the build is a promoted build then test privilege is disabled. In such a case, if any of the test fields were explicitly specified (note that requested_fields being specified as [] or undef implicitly means "get all fields") then a NACL::Exceptions::InvalidPrivilege is thrown. If none of the fields were explicitly requested (i.e. requested_fields is either [] or undef), then no exception is thrown. A special case is when test_fields is sent as []. This means "set to test privilege if possible". This setting to test privilege is not conditional on any fields being present. This is useful for cases like in Statistics, where there are no extra fields that show up in test privilege, but there are extra counters that show up in test privilege (i.e there are extra values for the same fields). =over =item Options =over =item C<< requested_fields => $requested_fields >> (Required, ARRAYREF) The requested_fields parameter passed to state/fetch. =item C<< filter => $filter >> (Required, HASHREF) The filter parameter passed to find/fetch. =item C<< test_fields => [ $field1, $field2, ...] >> (Required, ARRAYREF) This is a reference to the array of fields which can be obtained only in test privilege =item C<< apiset => $apiset >> (Required, isa NACL::APISet) A reference to the APISet object which is available in the fetch back-end =item C<< api_opts => \%opts >> (Required, HASHREF) A reference to the arguments passed to the API call. If the call needs to be made in test privilege, and can be made in test privilege, it updates this hashref to have the privilege-level set to test. =back =back =cut sub _set_to_test_priv { $Log->enter() if $may_enter; my $pkg = shift; $Log->debug( "Opts to 'set_to_test_priv' are:\n" . Dumper {@_} ); my %opts = validate( @_, { requested_fields => { type => ARRAYREF | UNDEF }, filter => { type => HASHREF }, test_fields => { type => ARRAYREF }, apiset => { isa => 'NACL::APISet' }, api_opts => { type => HASHREF }, } ); my $requested_fields = $opts{requested_fields}; my $filter = $opts{filter}; my $test_fields = $opts{test_fields}; my $apiset = $opts{apiset}; my $api_opts = $opts{api_opts}; # test_fields set to an empty array means set to test privilege # if possible if (( $pkg->_are_fields_present_in_req_or_filter( requested_fields => $requested_fields, filter => $filter, fields => $test_fields ) ) or ( !@{$test_fields} ) ) { my $version_manager = $apiset->get_version_manager(); try { if ( $version_manager->is_promoted() ) { # Test privilege is not accessible my $release = $version_manager->get_version_attribute( attribute => 'release' ); if ( !@{$test_fields} ) { $Log->debug( 'Cannot set to test privilege because ' . "the build is a promoted one (release: $release). " . "('test_fields' was set to [] in $pkg::fetch, meaning " . '"set to test privilege if possible")' ); } else { # Check if test fields were explicitly asked for # (through requested_fields or filter). If so, fail. # If they were implicitly asked for (i.e. by requested_fields # being [] or undef) then do not fail. # If requested_fields is not [] or undef, then it must have # been explicitly requested for if ( $pkg->_want_some_fields($requested_fields) ) { $Log->exit() if $may_exit; NACL::Exceptions::InvalidPrivilege->throw( 'One or more ' . 'of the following fields ' . Dumper($test_fields) . 'was provided in the filter or through ' . 'requested_fields. These are accessible only in ' . 'test privilege, however since this is a ' . "promoted build (release:$release) test " . 'privilege is disabled' ); } else { $Log->debug( 'The values for the fields ' . Dumper($test_fields) . 'could not be filled in because ' . 'they are accessible only in test privilege, but ' . "since this is a promoted build (release:$release)" . 'test privilege has been disabled' ); } } } else { # Not a promoted build. We can invoke the API in test privilege $api_opts->{'privilege-level'} = 'test'; } } catch NACL::APISet::Exceptions::ConnectionFailedException with { my $exception = shift; $Log->debug( 'Could not determine if the build is promoted or not ' . 'because the required connection could not be ' . 'established. Setting to test privilege (the API call ' . 'will fail if test privilege is inaccessible)' . "\n Error:\n" . $exception->text() ); $api_opts->{'privilege-level'} = 'test'; }; } $Log->exit() if $may_exit; } =head2 get_component_instance my $state_obj = NACL::CS::Foo->fetch(%opts); my $component_obj = $state_obj->get_component_instance(); (For component users) (Instance method only) This method returns the component object corresponding to a particular component state object. It throws a NATE::BaseException if no corresponding component package is found. (If the ComponentState object is of type NACL::CS::Foo, NACL::C::Foo is looked for) =cut sub get_component_instance { $Log->enter() if $may_enter; my $self = shift; my $error; if ( $self->_can_C_file_be_loaded( error_message_ptr => \$error ) ) { my %new_hash = (); my $C_pkg = $self->get_C_package_name(); my @primary_keys = $C_pkg->get_primary_keys(command_interface => $self->command_interface); unless (@primary_keys) { # get_component_instance() might have been called by the user # or internally (by find). # Determine if the caller was find(), and if so inform the user # to go through CS::fetch instead since there are no primary # keys for this component my @caller = caller(1); if ( $caller[3] eq 'NACL::C::Component::find' ) { my $CS_pkg = ref $self; $Log->warn( 'There are no primary keys for the component package ' . "'$C_pkg', hence $CS_pkg->fetch() should be invoked " . "instead of $C_pkg->find()." ); } else { # get_component_instance was invoked directly by the user. # Suggest the user to make all calls on this component # as package calls. $C_pkg =~ /.*::(.*)/; my $obj_name = $1; $Log->warn( 'There are no primary keys for the component package ' . "'$C_pkg', so the component object returned will only " . 'have a command_interface. It is suggested that all ' . "the methods of the component '$C_pkg' are invoked " . 'as package calls rather than as instance calls ' . "($C_pkg->method() rather than \$$obj_name->method())" ); } } foreach my $primary_key (@primary_keys) { my $value = $self->$primary_key(); $new_hash{$primary_key} = $value if ( defined $value ); } %new_hash = %{ NACL::C::Component::_convert_to_underscores( \%new_hash ) }; my $component = $C_pkg->new( %new_hash, command_interface => $self->command_interface() ); return $component; } else { NATE::BaseException->throw($error); } } sub get_task_instance { $Log->enter() if $may_enter; my $self = shift; my $comp_obj = $self->get_component_instance(); my $task_obj = $comp_obj->cast_component_to_task(); $Log->exit() if $may_exit; return $task_obj; } =head2 get_C_package_name my $C_package_name = $CS_obj->get_C_package_name(); or my $C_package_name = NACL::CS::Foo->get_C_package_name(); (For component users) (Class or instance method) This method returns the component package name corresponding to a CS object or package name. Example: NACL::CS::Foo it returns NACL::C::Foo. =cut sub get_C_package_name { my $CS_pkg_or_obj = shift; my $CS_pkg_name = ref $CS_pkg_or_obj ? ref $CS_pkg_or_obj : $CS_pkg_or_obj; my $C_pkg_name = $CS_pkg_name; $C_pkg_name =~ s/::CS::/::C::/; return $C_pkg_name; } =head2 _determine_filename_from_package my $filename = _determine_filename_from_package($package_name); (For component developers) Given a package name, determine its filename. A package A::B::C will have its filename be A/B/C.pm. This is necessary since when "require" is done with a literal, it needs to be the file name. "require" works for a package name only if it's provided as a bareword. More details: http://perldoc.perl.org/functions/require.html =cut sub _determine_filename_from_package { my @opts = validate_pos( @_, { type => SCALAR } ); my $package_name = $opts[0]; my $file_name = $package_name; $file_name =~ s/::/\//g; $file_name .= '.pm'; return $file_name; } =head2 _can_C_file_be_loaded $CS_obj->_can_C_file_be_loaded(); or NACL::CS::Foo->_can_C_file_be_loaded(); (For component developers) (Class or instance method) This method determines the C file corresponding to a CS object or package and returns 1 if the C file can be loaded, and 0 if it cannot be loaded. If it cannot be loaded, it updates the error message pointer to contain the error message. =over =item Options =over =item error_message_ptr This is a reference to a scalar variable, which gets filled in with the error message if the C file could not be loaded. =back =back =cut sub _can_C_file_be_loaded { my $CS_pkg_or_obj = shift; my %opts = validate( @_, { error_message_ptr => { type => SCALARREF } } ); my $error_message_ptr = $opts{error_message_ptr}; my $CS_pkg_name = ref $CS_pkg_or_obj ? ref $CS_pkg_or_obj : $CS_pkg_or_obj; my $C_pkg_name = $CS_pkg_or_obj->get_C_package_name(); my $C_file = _determine_filename_from_package( $C_pkg_name ); my $can_be_loaded = 1; # #Check whether the C package is already loaded # if ( $C_pkg_name->can('new') ) { return $can_be_loaded; } try { require $C_file; } otherwise { $can_be_loaded = 0; my $exception = shift; $$error_message_ptr = 'There is no component package corresponding ' . "to '$CS_pkg_name'\n" . "Error while trying to load '$C_file':\n" . $exception->text(); }; return $can_be_loaded; } # Returns 1 if we want only some fields, i.e. requested_fields is passed # in with a value. Requires requested_fields to be passed as parameter sub _want_some_fields { $Log->enter() if $may_enter; my ( $pkg, @args ) = @_; my @opts = validate_pos( @args, { type => ARRAYREF | UNDEF } ); my $requested_fields = $opts[0]; if ( defined $requested_fields && @{$requested_fields} ) { $Log->exit() if $may_exit; return 1; } else { $Log->exit() if $may_exit; return 0; } } # Returns 1 if we want all fields, i.e. requested_fields is undef or []. # Requires requested_fields to be passed as parameter sub _want_all_fields { $Log->enter() if $may_enter; my ( $pkg, @args ) = @_; my @opts = validate_pos( @args, { type => ARRAYREF | UNDEF } ); my $requested_fields = $opts[0]; if ( !defined $requested_fields || !@{$requested_fields} ) { $Log->exit() if $may_exit; return 1; } else { $Log->exit() if $may_exit; return 0; } } =head2 fetch sub fetch { my $pkg = shift; my @state_objs = $pkg->SUPER::fetch( @_, choices => [ { method => '_fetch_mode_interface', interface => 'interface', set => 'set' } ], exception_text => 'No matching foo(s) found' ); return @state_objs; } The only pieces of information that differ among the fetch method of various CS modules are the choices for the call_on_apiset call and the exception text for the NoElementsFound exception that is thrown. All ComponentState fetch implementations can pass control to this base class method to do most of the work. =over =item Options =over =item C<< choices => [ { %choice1 }, { %choice2 }, ... ] >> The choices array-reference to be passed to the call_on_apiset call. =item C<< exception_text => $scalar >> If no state objects are found and allow_empty is 0 then a NACL::Exceptions::NoElementsFound exception is thrown, which starts with the string "No matching (s) found". (Example: "No matching aggregate(s) found"). This is to be sent as the exception text argument. =item C<< is_singleton => 0 | 1 >> (Optional, defaults to 0) This specifies whether the table is a singleton: i.e. only one row is returned. This is necessary for CMode CLI: normally filtering is disabled for CMode-CLI but for singleton tables this should be performed since the command cannot do the filtering for us. =item C<< connectrec-max_idle => $seconds >> (Optional, defaults to 300) The connectrec-max_idle is applicable for CMode CLI only. Time in seconds to wait if the command does not produce some output for a period of more than this many seconds for this connection to time out. =back =back =cut =head2 The 'randomize_order' randomizes the order of the objects returned . Don't assign a default for randomize_order, we do a check for defined(), so we don't want to wrongly trigger it by assigning a default randomize_order => { type => BOOLEAN, optional => 1 }, =cut # The Seed used for the randomization of find/fetch results my $Global_CS_MT_Obj; # Leaving this undocumented since we only want # NACL::C::Component->set_fetch_randomization() to modify this our $_randomize_fetch; =head2 fetch_with_retries NACL::CS::foo->fetch_with_retries ( command_interface => $command_interface, ..... ); This method retries on the fetch calls in cases where NACL::Exceptions::NoElementsFound is thrown =cut sub fetch_with_retries { $Log->enter() if $may_enter; my ( $pkg, @args ) = @_; my %fetch_opts = validate_with( params => \@args, spec => { retries_count => { type => SCALAR, default => 5 }, sleep_time => { type => SCALAR, default => 10 }, }, # Other options accepted by fetch are validated by _fech_validate_spec allow_extra => 1 ); my $retry_count = delete $fetch_opts{retries_count} ; my $sleep_time = delete $fetch_opts{sleep_time}; my @state_objs; nacl_method_retry( code => sub {@state_objs = $pkg->fetch(%fetch_opts)}, tries_count => $retry_count, sleep_time => $sleep_time, exceptions => ['NACL::Exceptions::NoElementsFound'] ); $Log->exit() if $may_exit; return @state_objs; } sub fetch { $Log->enter() if $may_enter; my ( $pkg, @args ) = @_; my %fetch_opts = validate_with( params => \@args, spec => { choices => { type => ARRAYREF }, exception_text => { type => SCALAR }, is_singleton => { type => SCALAR, default => 0 } }, # Other options accepted by fetch are validated by _fech_validate_spec allow_extra => 1 ); my $choices = delete $fetch_opts{choices}; my $exception_text = delete $fetch_opts{exception_text}; my $is_singleton = delete $fetch_opts{is_singleton}; # We want the options to be dumped using NACL::ComponentUtils::Dumper, not # Data::Dumper::Dumper. Hence we "require" this file here. require NACL::ComponentUtils; $Log->debug( sub { "Opts to 'fetch' frontend are:\n" . NACL::ComponentUtils::Dumper( \%fetch_opts ); } ); my %opts = validate_with( params => \%fetch_opts, spec => $pkg->_fetch_validate_spec() ); my $allow_empty = delete $opts{allow_empty}; my @exceptions_to_ignore = $opts{command_interface}->exceptions_to_ignore(); $allow_empty = 1 if ( (!$allow_empty) && (grep( /NACL::Exceptions::NoElementsFound/, @exceptions_to_ignore )) ); my $ignore_tharn_params = delete $opts{_ignore_tharn_params}; my $randomize_order = delete $opts{'randomize_order'}; my $sort_ascending = delete $opts{sort_ascending}; my $sort_descending = delete $opts{sort_descending}; my $unknown_fields_added = delete $opts{unknown_fields_added_by_backend}; my $dummy; # We need to know the apiset chosen even if the caller hasn't # asked for it $opts{apiset_chosen} ||= \$dummy; my $filter = { %{ $opts{filter} } }; my $requested_fields; # If allow_extra is passed, then weed out unknown filter fields # and requested_fields my $allow_extra = delete $opts{allow_extra}; if ($allow_extra) { foreach my $key ( keys %{ $opts{filter} } ) { if ( !$pkg->can($key) ) { delete $filter->{$key}; } } my @valid_req_fields; foreach my $req_field ( @{ $opts{requested_fields} } ) { push( @valid_req_fields, $req_field ) if ( $pkg->can($req_field) ); } $requested_fields = \@valid_req_fields; } else { $requested_fields = [ @{ $opts{requested_fields} } ]; } my %param_filter; if ( !$ignore_tharn_params ) { # This section of code is to provide support for filters such as # NACL_FILTER_VOLUME="{ state => 'online' }" and # NACL_FILTER_VOLUME=vol my $str; my $cmd_line_filter = sub { my ($package) = validate_pos( @_, { type => SCALAR } ); # Given a particular package name, determine what the appropriate # filter parameter would be. For example, # NACL::CS::StorageAggregate would turn correspond to # parameter NACL_FILTER_STORAGEAGGREGATE. So, we extract # the portion after the NACL::CS::, then upper case it to get # the parameter name. # Where this does not work is where the CS module is within # a further directory, say NACL::CS::DFM::Aggregate. In this # case, the final portion if "DFM::Aggregate". The "::" gets # interpreted, so cannot be provided as a parameter name. We # turn it into underscores, so the parameter would be # NACL_FILTER_DFM_AGGREGATE. $package =~ /NACL::CS::(.*)/; my $param_key = uc $1; $param_key =~ s/::/_/g; my $param = "NACL_FILTER_$param_key"; $str = Tharn::param($param); if ($str) { my $evaled_str; if ( $str =~ /^\w+$/ ) { $evaled_str = $str; } else { $evaled_str = eval $str; if ($@) { $Log->exit() if $may_exit; NATE::Exceptions::Argument->throw( 'Failure while attempting ' . "to parse the parameter '$param'. This is " . 'most likely because the value is not ' . "valid Perl code.\nValue: $str\n" . "Full error:\n" . $@ ); } } if ( !ref $evaled_str ) { my $C_pkg = $pkg->get_C_package_name(); if ( $C_pkg->can('name_attribute') ) { $param_filter{ $C_pkg->name_attribute() } = $evaled_str; } else { $Log->exit() if $may_exit; NATE::Exceptions::Argument->throw( 'The value of the ' . "parameter '$param' was a string but since " . "there is no 'name_attribute' defined for " . "the relevant Component package ('$C_pkg') " . 'we do not know which field to apply the ' . 'filter for' ); } } elsif ( ref $evaled_str eq 'HASH' ) { %param_filter = %$evaled_str; } else { $Log->exit() if $may_exit; NATE::Exceptions::Argument->throw( 'Filter parameters ' . 'can be provided either as a string or as a ' . "hash-reference, but parameter '$param' was " . 'provided as a ' . ref($evaled_str) . '. Value: ' . _dump_one($evaled_str) . "\n" ); } } }; $cmd_line_filter->($pkg); # If $str was not populated, then the test parameter was not provided. # Determine if this is an alias CS file and if so, then look for # the test parameter related to the "real" CS unless ($str) { my $real_pkg = $pkg->_real_cs(); $cmd_line_filter->($real_pkg) if $real_pkg; } } my %canned_filter_hash; my $canned_filters = delete $opts{canned_filters}; foreach my $canned_filter (@$canned_filters) { my $canned_filter_method = "_canned_filter_$canned_filter"; if ( $pkg->can($canned_filter_method) ) { # Pass in the command_interface to canned filter method so # it can make decisions based on mode/version if necessary # It can of course choose to simply ignore it. my $single_filter = $pkg->$canned_filter_method( command_interface => $opts{command_interface} ); %canned_filter_hash = ( %canned_filter_hash, %$single_filter ); } else { $Log->exit() if $may_exit; NATE::Exceptions::Argument->throw( "Invalid canned filter $canned_filter"); } } # Ensure that "filter" takes higher priority than "canned_filters" $filter = { %param_filter, %canned_filter_hash, %$filter }; # Fix for scenario outlined in burt 437206. # Certain 'show' commands take more than 60 seconds to complete, so would # timeout with the normal output and 'find' and 'fetch' would fail. # We circumvent by setting a large timeout. # However, a user-specifed timeout is provided higher preference than our # default value. $opts{'method-timeout'} ||= 1200; # If either "sort_ascending" or "sort_descending" are provided, then # add these fields to the requested_fields if ( @$sort_ascending || @$sort_descending ) { if (@$requested_fields) { my %req_field_hash; foreach my $req_field (@$requested_fields) { $req_field_hash{$req_field} = 1; } foreach my $field ( ( @$sort_ascending, @$sort_descending ) ) { unless ( exists $req_field_hash{$field} ) { push @$requested_fields, $field; } } } } my $validate_input = 1; my $apiset_backend; if ( !$opts{show_cmd} && $opts{command_interface}->isa('NACL::C::CommandInterface::ONTAP') ) { $apiset_backend = $pkg->call_on_apiset( %opts, choices => $choices, do_not_call_backend => 1 ); my $apiset_chosen = ${ $opts{apiset_chosen} }; if ( $apiset_chosen->{interface} eq 'CLI' && $apiset_chosen->{set} eq 'CMode' ) { $validate_input = 0; } } if ( !$unknown_fields_added && $validate_input ) { #The cmode cli and zapi backend would validate the fields #based on help_xml my %input_args = ( requested_fields => $requested_fields, filter => $filter, ); if ( $opts{command_interface}->isa('NACL::C::CommandInterface::ONTAP') and !$opts{command_interface}->isa('NACL::C::SysManager::SMClient') ) { %input_args = ( %input_args, command_interface => $opts{command_interface}, show_cmd => $opts{show_cmd},); } $pkg->_check_for_invalid_requested_filter_fields(%input_args); } my $filter_without_regex = {%$filter}; my $contains_regex; # Dangerous to delete from the hash being iterated over; hence not # iterating over $filter_without_regex. while (my ($key, $value) = each %$filter) { # If any of the filter values are regexes, then don't pass them # onto the back-end method. if (_is_regexp($value)) { $contains_regex = 1; delete $filter_without_regex->{$key}; # Add this field to requested_fields IFF requested_fields is not [] push (@$requested_fields, $key) if (@$requested_fields); } } my $apply_filter = 1; my %call_on_apiset_input = ( %opts, choices => $choices, filter => $filter_without_regex, requested_fields => $requested_fields, _apply_filter => \$apply_filter, ); if ( $apiset_backend ) { $call_on_apiset_input{apiset_backend_already_chosen} = $apiset_backend; } my @state_objs = $pkg->call_on_apiset( %call_on_apiset_input ); if ($unknown_fields_added) { #Backend would have added new fields to methodmaker $pkg->_check_for_invalid_requested_filter_fields( requested_fields => $requested_fields, filter => $filter, command_interface => $opts{command_interface}, ); } # Back-end methods might set $apply_filter to 0, but if there is a regex # filter provided, then we need to filter here. $apply_filter = 1 if $contains_regex; if ($apply_filter) { $pkg->_apply_filter( state_objs => \@state_objs, filter => $filter, ); } if ( !@state_objs ) { if ($allow_empty) { $Log->exit() if $may_exit; return @state_objs; } else { $pkg->_throw_no_elements_found( exception_text => $exception_text, filter => $filter, fetch_args => \%fetch_opts, ); } } if ( $opts{verify_count} ) { my $expected_count = $opts{verify_count}; my $actual_count = scalar(@state_objs); if ( $actual_count != $expected_count ) { $Log->exit() if $may_exit; NACL::Exceptions::VerifyCountFailure->throw( "Mismatch on the number of cs objects returned \n". "expected count: $expected_count actual count: $actual_count") } } # The "randomize_order" argument to the call taken highest precedence, # followed by the global setting made by set_fetch_randomization, # and finally the test parameter. $randomize_order //= $_randomize_fetch if ( defined $_randomize_fetch ); if ( !defined $randomize_order ) { $randomize_order = Tharn::param('NACL_RANDOMIZE_ORDER'); } if ( @$sort_ascending || @$sort_descending ) { if (@$sort_ascending) { @state_objs = $pkg->sort_ascending( state_objs => \@state_objs, fields => $sort_ascending ); } if (@$sort_descending) { @state_objs = $pkg->sort_descending( state_objs => \@state_objs, fields => $sort_descending ); } } elsif ($randomize_order) { if ( !defined $Global_CS_MT_Obj ) { my $seed; $Global_CS_MT_Obj = Math::Random::MT::Auto->new(); my $param = Tharn::param('NACL_RANDOMIZE_ORDER_SEED'); if ( defined $param ) { $Global_CS_MT_Obj->srand($param); $seed = $param; } else { $seed = $Global_CS_MT_Obj->get_seed()->[0]; } $Log->comment( "Using $seed as the seed for randomizing results " . 'returned from find/fetch' ); } $Global_CS_MT_Obj->shuffle( \@state_objs ); } $Log->exit() if $may_exit; return @state_objs; } sub _is_regexp { ref $_[0] eq 'Regexp' } sub sort_ascending { $Log->enter() if $may_enter; my ( $pkg, @args ) = @_; my @state_objs = $pkg->_sort( @args, ascending => 1 ); $Log->exit() if $may_exit; return @state_objs; } sub sort_descending { $Log->enter() if $may_enter; my ( $pkg, @args ) = @_; my @state_objs = $pkg->_sort( @args, ascending => 0 ); $Log->exit() if $may_exit; return @state_objs; } sub _sort { $Log->enter() if $may_enter; my ( $pkg, @args ) = @_; my %opts = validate_with( params => \@args, spec => { state_objs => { type => ARRAYREF }, fields => { type => ARRAYREF }, ascending => { type => SCALAR } } ); my $fields = $opts{fields}; my @state_objs = @{ $opts{state_objs} }; my $ascending = $opts{ascending}; foreach my $field (@$fields) { my $normalized_field = sub { my $state_obj = shift; unless ($state_obj->isa($pkg)) { NATE::Exceptions::Argument->throw('Parameter to ' ."\$normalized_field was not a $pkg"); } my $converted_value; try{ $converted_value = NACL::C::UnitNormalization::convert_to_bytes( $state_obj->$field() ); }catch NATE::Exceptions::Argument with{ #return input value as an output if unable to convert in bytes $converted_value = $state_obj->$field(); }; return $converted_value; }; if ( $pkg->can($field) ) { no warnings; if ($ascending) { @state_objs = sort { $normalized_field->($a) <=> $normalized_field->($b) || $normalized_field->($a) cmp $normalized_field->($b) } @state_objs; } else { @state_objs = sort { $normalized_field->($b) <=> $normalized_field->($a) || $normalized_field->($b) cmp $normalized_field->($a) } @state_objs; } use warnings; } else { my $method = 'sort_'; $method .= $ascending ? 'ascending' : 'descending'; $Log->exit() if $may_exit; NATE::Exceptions::Argument->throw( "The field '$field' " . "was provided in the call to '$method' but it is " . "not listed as an attribute of '$pkg'" ); } } $Log->exit() if $may_exit; return @state_objs; } =head2 verify_fields $cs_obj->verify_fields(%fields_to_verify); (Instance method) Given a CS object instance, check whether all the fields match the specified values. If one or more of the values of the CS object fields do not match what we specified, a L exception is thrown. =over =item Options =over C (Required) A hash of options specifying all the fields whose values in the CS object we want to verify. =back =back =cut sub verify_fields { $Log->enter() if $may_enter; my ( $self, %opts ) = @_; my $pkg = $self->get_package_name(); $pkg->_apply_filter( state_objs => [$self], filter => \%opts, return_on_mismatch => 0 ); $Log->exit() if $may_exit; } # This is the formatting string used for the verification error message sub _common_formatting_for_verification { return "%-20s%-20s%-20s"; } # Returns NoElementsFound object sub _throw_no_elements_found { my ( $pkg, @args ) = @_; $Log->enter() if $may_enter; my %opts = validate_with( params => \@args, spec => { filter => { type => HASHREF }, exception_text => { type => SCALAR }, fetch_args => { type => HASHREF, optional => 1 }, }, ); my $exception = NACL::Exceptions::NoElementsFound->new( $opts{exception_text} . "\nFilter: " . _dump_one( $opts{filter} ) . "\n" ); if (defined $opts{fetch_args}) { $exception->fetch_args( $opts{fetch_args} ); $exception->pkg_name($pkg); } $Log->exit() if $may_exit; $exception->throw(); } =head2 _update_verification_failure_str_and_hash $pkg->_update_verification_failure_str_and_hash( msg_ref => \$msg, hashref => $hashref, field => $field, expected_value => $expected_value, obtained_value => $obtained_value ); When the verification performed by L fails, a L exception is thrown. This exception contains a formatted error message (essentially formatted to look somewhat like a table), along with a hash-reference of fields/values that didn't match the expected value. This method updates the message and hash-reference to include entries for a new field/value that doesn't match. =over =item Options =over =item C<< msg_ref => \$msg >> Reference to the error message. The method updates this message. =item C<< hashref => $hashref >> A reference to the hash containing the field/value mapping for the fields that didn't match. =item C<< field => $field >> The field name for which there was a mismatch. =item C<< expected_value => $expected_value >> The expected value for that field. =item C<< obtained_value => $obtained_value >> The obtained value for that field. =back =back =cut sub _update_verification_failure_str_and_hash { $Log->enter() if $may_enter; my $pkg = shift; my %opts = validate_with( params => \@_, spec => { msg_ref => { type => SCALARREF }, hashref => { type => HASHREF }, field => { type => SCALAR }, expected_value => { required => 1 }, obtained_value => { required => 1 }, } ); my $field = $opts{field}; my $expected_value = $opts{expected_value}; my $obtained_value = $opts{obtained_value}; my $msg_ref = $opts{msg_ref}; my $hashref = $opts{hashref}; my $formatted_value; my @sprintf_arr = ( _common_formatting_for_verification(), $field ); if ( ref $expected_value ) { # If the expected/obtained values are arrays, then use _dump_one # to print them $formatted_value = sprintf _common_formatting_for_verification(), $field, _dump_one($expected_value), _dump_one($obtained_value); } else { $formatted_value = sprintf _common_formatting_for_verification(), $field, "'$expected_value'", "'$obtained_value'"; } $$msg_ref .= "$formatted_value\n"; $hashref->{$field} = $obtained_value; $Log->exit() if $may_exit; } =head2 _throw_verification_failure $pkg->_throw_verification_failure( message => $error_message, hashref => $hashref ); Throws a C exception with the provided error message and hash-reference. =over =item Options =over =item C<< message => $message >> The error message. =item C<< hashref => $hashref >> The hash-reference containing the field/value mappings for the fields for which there was a mismatch in value. =back =back =cut sub _throw_verification_failure { $Log->enter() if $may_enter; my $pkg = shift; my %opts = validate_with( params => \@_, spec => { message => { type => SCALAR }, hashref => { type => HASHREF }, } ); my $msg = $opts{message}; my $formatted_headers = sprintf _common_formatting_for_verification(), 'Field', 'Expected Value', 'Obtained Value'; $msg = 'Verification failed! One or more of the fields did ' . "not match the expected values\n" . "$formatted_headers\n" . "$msg\n"; $Log->exit() if $may_exit; NACL::Exceptions::VerifyFailure->throw( $msg, unexpected_values => $opts{hashref} ); } =head2 _check_for_invalid_requested_filter_fields sub fetch { ... $pkg->_check_for_invalid_requested_filter_fields( requested_fields => $opts{requested_fields}, filter => $opts{filter} ); ... $pkg->call_on_apiset(...); ... } (For component developers) This method checks for any invalid requested fields or filter field passed by the user. It does this by checking whether an accessor method has been defined for each of the requested fields and filter fields. In case it does not find an accessor method for any of the fields, it throws a C exception. =over =item Options =over =item C<< requested_fields => $requested_fields >> (Mandatory) The requested_fields parameter passed by the user. =item C<< filter => $filter >> (Mandatory) The filter parameter passed by the user. =item C<< additional_filter_fields => \@additional_fields >> (Optional, ARRAYREF) Certain CS modules allow fields to be provided in the filter even though they are not present in the MethodMaker. These can be specified through this optional argument. =back =back =cut sub _check_for_invalid_requested_filter_fields { $Log->enter() if $may_enter; my $pkg = shift; my %opts = validate @_, { requested_fields => { type => ARRAYREF | UNDEF }, filter => { type => HASHREF }, additional_filter_fields => { type => ARRAYREF, default => [] }, }; my (@invalid_filter, @invalid_requested, $err_str, %invalid_fields); my $check_if_valid_field = sub { my %opts = validate @_, { fields => { type => ARRAYREF } }; my $fields = $opts{fields}; my @invalid_fields; foreach my $field (@$fields) { if ( !$pkg->can($field) ) { push ( @invalid_fields, $field ) } } return \@invalid_fields; }; my $requested_fields = $opts{requested_fields}; if ( defined $requested_fields ) { my $invalid_requested_fields = $check_if_valid_field->( fields => $requested_fields ); if ( @$invalid_requested_fields ) { $err_str = "\n Unknown requested fields: ".join(",",@{ $invalid_requested_fields }); $invalid_fields{'unknown_requested_fields'} = $invalid_requested_fields; } } my $additional_fields = $opts{additional_filter_fields}; if ( !@$additional_fields ) { $additional_fields = $pkg->_extra_filter_fields(); } my %filter = %{ $opts{filter} }; foreach my $field (@$additional_fields) { delete $filter{$field}; } my @keys_of_filter = keys %filter; if ( @keys_of_filter ) { my $invalid_filter_fields = $check_if_valid_field->( fields => \@keys_of_filter ); if ( @$invalid_filter_fields ) { $err_str .= "\n Unknown filter fields: ".join(",",@{ $invalid_filter_fields }); $invalid_fields{'unknown_filters'} = $invalid_filter_fields; } } if ( keys %invalid_fields ) { $err_str .= "\n This could be " . "because:\n" . "\t1. The field(s) is invalid\n" . "\t2. The field(s) is valid but has not been " . "implemented on the CS object '$pkg'. If " . 'this is the case, please raise a burt against ' . 'nacl (type=nacl;subtype=nacl_core) or mail ' . 'dl-nacl-dev@netapp.com regarding the issue'; $Log->exit() if $may_exit; NACL::Exceptions::InvalidFilterField->throw($err_str, %invalid_fields); } # Check if the data-types of the filter fields matches what they're # defined as in MethodMaker $pkg->_check_data_type_of_filter( filter => \%filter ); $Log->exit() if $may_exit; } =head2 _check_data_type_of_filter $pkg->_check_data_type_of_filter(filter => \%filter); This method checks the data types of the values provided for the filter fields against the data types of those fields as defined in MethodMaker. Any mismatches results in a C exception being thrown. =over =item Options =over =item C<< filter => \%filter >> A reference to the filter hash. =back =back =cut sub _check_data_type_of_filter { $Log->enter() if $may_enter; my $pkg = shift; my %opts = validate_with( params => \@_, spec => { filter => { type => HASHREF } } ); while ( my ( $key, $value ) = each %{ $opts{filter} } ) { next if ( !$pkg->can($key) ); my $obj_ref = ref $pkg->$key(); my ( $filter_ref, $is_blessed ); # blessed() returns true if the value is a regexp (WTF?), so # we need extra code to check if it is REALLY an object. my $value_is_regex = _is_regexp($value); if (!$value_is_regex && blessed ($value)) { $is_blessed = 1; # Objects which "isa" NACL::C::Component are allowed in the # filter, no other types of objects should be allowed if ( $value->isa('NACL::C::Component') ) { # A single component object provided as value # Treat it like a scalar. my $scalar; $filter_ref = ref $scalar; } else { $Log->exit() if $may_exit; NATE::Exceptions::Argument->throw( 'Values for filter ' . 'fields are allowed to be objects of type ' . 'NACL::C::Component (and subclasses thereof) but ' . "the value for the '$key' filter field was " . 'provided as an object of type ' . ref($value) ); } } else { $filter_ref = ref $value; } if (!$value_is_regex && $obj_ref ne $filter_ref) { my $sub = sub { $_[0] ? 'an array-reference' : 'a scalar' }; my $required_type = $sub->($obj_ref); my $provided_type = $sub->($filter_ref); my $value_dumper; if ($is_blessed) { # _dump_one on component objects leads to long, unwieldy # text (which isn't particularly decipherable). For objects, # instead of dumping what's in the object, let's just state # what sort of object was passed $value_dumper = "object of type '" . ref($value) . "'"; } else { $value_dumper = _dump_one($value); } $Log->exit() if $may_exit; NATE::Exceptions::Argument->throw( "The filter field '$key' (" . $value_dumper . ") should have been provided as $required_type but was " . "provided as $provided_type " ); } } $Log->exit() if $may_exit; } =head2 _remove_relational_regex_filters sub _fetch_7mode_cli { my $pkg = shift; ... my $deleted_filter = $pkg->_remove_relational_regex_filters( filter => { aggregate => 'a*' }, ); ... } This method removes relational or regex filter from the input filter hashref and returns a hashref which contains the removed filters =cut sub _remove_relational_regex_filters { $Log->enter() if $may_enter; my ( $pkg, @args ) = @_; my %opts = validate @args, { filter => { type => HASHREF }, requested_fields => { type => ARRAYREF, optional => 1 } }; my %deleted_filters; my $filter = $opts{filter}; foreach my $field ( keys %{$filter} ) { # Search for the allowed regular expresions for CMode. if ( defined $filter->{$field} && !ref $filter->{$field} && $pkg->_check_relational_regex_filter(filter_value => $filter->{$field}) ) { $deleted_filters{$field} = delete $filter->{$field}; } } # Any fields deleted from the filter should be moved into requested_fields # so that _want_any_field_of works correctly. (i.e. _want_any_field_of # matches if a field is either in filter or requested_fields. So if it's # deleted from filter, it should be moved into requested_fields) # However, copy it over only if requested_fields is not [] ([] means fetch # all fields in any case) if ( defined $opts{requested_fields} && @{ $opts{requested_fields} } ) { my @requested_fields = @{ $opts{requested_fields} }; push @requested_fields, keys %deleted_filters; @{ $opts{requested_fields} } = @requested_fields; } $Log->exit() if $may_exit; return \%deleted_filters; } =head2 _case_insensitive_attributes The base class definition returns undef indicating that it doesn't know the attributes which need to be treated in case insensitive way during filtering. The subclases are expected to implement this for specifying case insensitive attributes. Return value: [] -> denotes that all attributes should be considered case insensitive [qw(a b c)] -> only the attributes a, b, and c are case insensitive. Example: From NACL::CS::SystemLicense sub _case_insensitive_attributes { $Log->enter() if $may_enter; $Log->exit() if $may_exit; return [qw(license-code feature package)]; } =cut sub _case_insensitive_attributes { $Log->enter() if $may_enter; $Log->exit() if $may_exit; return undef; } =head2 _apply_relational_regex_filters sub fetch { my $pkg = shift; my @state_objs = $pkg->call_on_apiset(...); my $filter = { 'availsize' => '>10m', 'aggregate' => 'comp*' }; $pkg->_apply_relational_regex_filters( state_objs => \@state_objs, filter => $filter ); ... } This method filters the state objects returned by call_on_apiset and returns only those that matches the filter. It is meant only for applying relational or regex filters on the state objects =cut sub _apply_relational_regex_filters { $Log->enter() if $may_enter; my ( $pkg, @args ) = @_; my $ret; my %opts = validate @args, { state_objs => { type => ARRAYREF }, filter => { type => HASHREF }, return_on_mismatch => { type => SCALAR, default => 1, }, msg_ref => { type => SCALARREF, optional => 1 }, hashref => { type => HASHREF, optional => 1 } }; # if return_on_mismatch is 0, then "msg_ref" and "hashref" are # mandatory if ( !$opts{return_on_mismatch} ) { my @not_defined; foreach my $arg (qw(msg_ref hashref)) { if ( !defined $opts{$arg} ) { push @not_defined, $arg; } } if (@not_defined) { my $msg = join ', ', @not_defined; my ( $argument_arguments, $was_were ); if ( @not_defined > 1 ) { $argument_arguments = 'arguments'; $was_were = 'were'; } else { $argument_arguments = 'argument'; $was_were = 'was'; } $Log->exit() if $may_exit; NATE::Exceptions::Argument->throw( "When 'return_on_mismatch' " . "is set to 0, then both of 'msg_ref' and 'hashref' " . "should have been sent but the $argument_arguments " . "$msg $was_were not sent" ); } } my $filter = $opts{filter}; my $state_objs = $opts{state_objs}; my $msg_ref = $opts{msg_ref}; my $hashref = $opts{hashref}; my $case_insensitive_arr_ref = $pkg->_case_insensitive_attributes(); my @case_insensitive_arr = (); my %case_insensitive_attr = (); # Let's enable this flag by default my $case_insensitive_check_enabled = 1; if ( !defined $case_insensitive_arr_ref ) { # CS has returned undef. So it doesn't know what all attributes be # considered in a case insensitive manner. Hence disable the flag # which means the default is to always consider all attributes in a # case sensitive way. $case_insensitive_check_enabled = 0; } else { @case_insensitive_arr = @$case_insensitive_arr_ref; $Log->debug( sub { "case insensitive attributes of '$pkg' are \n" . Dumper( \@case_insensitive_arr ); } ); %case_insensitive_attr = map { ( $_ => 1 ) } @case_insensitive_arr; } my $matches_filter = sub { my ($state_obj) = @_; foreach my $field ( keys %$filter ) { # Nothing to do if the filter field is undef next if ( !defined $filter->{$field} ); my $value = $state_obj->$field(); # No filtering possible if no value for this field next if ( !defined $value ); my $original_value = $value; my $original_filter_value = $filter->{$field}; my ( $str, $lhs, $rhs ); if ( $filter->{$field} =~ /[*|!]/ ) { $str = $filter->{$field}; if ($case_insensitive_check_enabled) { if ( !scalar(@case_insensitive_arr) || exists $case_insensitive_attr{$field} ) { # Convert both LHS and RHS to lowercase $str = lc($str); $value = lc($value); } } if ( $str =~ /\|/ ) { $str =~ s/\|/\$\)\|\(\^/g; $str = "(^" . $str . "\$)"; } elsif ( $str !~ /^!/ ) { $str = "^" . $str . "\$"; } $str =~ s/\*/\.\*/g; # # Escaping non-word characters on the retrieved value # $value = '"' . quotemeta($value) . '"'; #Escaping "/" $str =~ s/\//\\\//g; if ( $str =~ /^!(.+)/ ) { $str = "$value !~ /^$1\$/"; } else { $str = "$value =~ /$str/"; } } elsif ( $filter->{$field} =~ /([<>]\=?)(.+)/ ) { my $filter_expr = $1; my $filter_value = $2; $rhs = NACL::C::UnitNormalization::to_bytes($filter_value); $rhs =~ s/(\d+)(\D*)/$1/g; $lhs = NACL::C::UnitNormalization::to_bytes($value); $lhs =~ s/(\d+)(\D*)/$1/g; $str = $lhs . " $filter_expr " . $rhs; } elsif ( $filter->{$field} =~ /(.+)\.\.(.+)/ ) { my $rhs1 = $1; my $rhs2 = $2; $rhs1 = NACL::C::UnitNormalization::to_bytes($rhs1); $rhs1 =~ s/(\d+)(\D*)/$1/g; $rhs2 = NACL::C::UnitNormalization::to_bytes($rhs2); $rhs2 =~ s/(\d+)(\D*)/$1/g; $lhs = NACL::C::UnitNormalization::to_bytes($value); $lhs =~ s/(\d+)(\D*)/$1/g; $str = "$lhs >= " . $rhs1 . " && $lhs <= " . $rhs2; } else { # To avoid open 'if-elsif' $Log->exit() if $may_exit; NATE::BaseException->throw( "Found no known special characters" . " in the filter.\nFilter: '$original_filter_value'." . " Value obtained: '$original_value'" ); } $ret = 0; my $if = "if ( " . $str . " ) { \$ret = 1; } else { \$ret = 0; }"; eval "$if"; if ($@) { $Log->exit() if $may_exit; NATE::BaseException->throw( "Expression is " . $if . " Errors " . $@ ); } if ( !$ret ) { if ( $opts{return_on_mismatch} ) { return 0; } else { $pkg->_update_verification_failure_str_and_hash( msg_ref => $msg_ref, hashref => $hashref, field => $field, expected_value => $original_filter_value, obtained_value => $original_value ); } } } return 1; }; @{$state_objs} = grep( $matches_filter->($_), @{$state_objs} ); $Log->exit() if $may_exit; return @{$state_objs}; } =head2 get_matching_objects my @cs_objects = NACL::CS::Aggregate->fetch(command_interface => $ci); my @matching_cs_instances = NACL::CS::ComponentState->get_matching_objects( state_objs => \@cs_objects, filter => { aggregate => "test_aggr*", avail_size => ">1g" }, ); (Class method only) This method filters the given CS instances using the filter provided and returns an array containing the matching CS instances. =over =item Options =over =item C<< state_objs => \@cs_instances_to_filter >> (Mandatory) The array reference to the arry of NACL::CS instances, which needs to be filtered. =item C<< filter => $filter >> (Mandatory) The hashref filter parameter passed by the user. =back =back =cut sub get_matching_objects { $Log->enter() if $may_enter; my $pkg = shift; my %opts = validate @_, { state_objs => { type => ARRAYREF }, filter => { type => HASHREF }, }; my @state_objs = @{ $opts{state_objs} }; foreach my $value (@state_objs) { if ( blessed($value) && $value->isa('NACL::CS::ComponentState') ) { # Apply the filter for allowed CS objects. $pkg->_apply_filter( state_objs => \@state_objs, filter => $opts{filter}, ); } else { NATE::Exceptions::Argument->throw( 'Each of the values of the' . 'state_objs argument are allowed to be objects of type' . 'NACL::CS::ComponentState (and subclasses thereof) but ' . 'one of the values was provided as a ' . ref($value) . "'. Dumper:\n" . NACL::ComponentUtils::Dumper($value) ); } } $Log->exit() if $may_exit; return @state_objs; } =head2 get_matching_C_objects my @cs_objects = NACL::CS::Aggregate->fetch(command_interface => $ci); my @matching_c_instances = NACL::CS::ComponentState->get_matching_C_objects( state_objs => \@cs_objects, filter => { aggregate => "test_aggr*", avail_size => ">1g" }, ); (Class method only) This method filters the given CS instances using the filter provided and returns an array containing the component instances matching criteria. =over =item Options =over =item C<< state_objs => \@cs_instances_to_filter >> (Mandatory) The array reference to the arry of NACL::CS instances, which needs to be filtered. =item C<< filter => $filter >> (Mandatory) The hashref filter parameter passed by the user. =back =back =cut sub get_matching_C_objects { $Log->enter() if $may_enter; my $pkg = shift; my @state_objs = $pkg->get_matching_objects(@_); my @c_objects; foreach my $state_obj (@state_objs) { push @c_objects, $state_obj->get_component_instance(); } $Log->exit() if $may_exit; return @c_objects; } =head2 get_matching_task_objects my @cs_objects = NACL::CS::Aggregate->fetch(command_interface => $ci); my @matching_stask_instances = NACL::CS::ComponentState->get_matching_task_objects( state_objs => \@cs_objects, filter => { aggregate => "test_aggr*", avail_size => ">1g" }, ); (Class method only) This method filters the given CS instances using the filter provided and returns an array containing the task instances matching criteria. =over =item Options =over =item C<< state_objs => \@cs_instances_to_filter >> (Mandatory) The array reference to the arry of NACL::CS instances, which needs to be filtered. =item C<< filter => $filter >> (Mandatory) The hashref filter parameter passed by the user. =back =back =cut sub get_matching_task_objects { $Log->enter() if $may_enter; my $pkg = shift; my @c_objs = $pkg->get_matching_C_objects(@_); my @task_objects; foreach my $c_obj (@c_objs) { push @task_objects, $c_obj->cast_component_to_task(); } $Log->exit() if $may_exit; return @task_objects; } =head2 build_associated_object $vol_cs->build_associated_object(type => 'NACL::C::Aggregate'); Uses details present in the CS object to build component or STask objects for elements related to this component. This requires that all of the primary keys of the C/STask object are present in the CS object. This method throws a NATE::Exceptions::Argument exception if an invalid object type is specified in 'type' input. Any other failures result in a NATE::BaseException being thrown. =cut sub build_associated_object { $Log->enter() if $may_enter; my $self = shift; my %opts = validate_with( params => \@_, spec => { type => { type => SCALAR }, }, ); my $to_component = $opts{type}; eval "require $to_component"; my $error = $@; if ($error) { $Log->exit() if $may_exit; NATE::Exceptions::Argument->throw( 'Could not import package ' . "'$to_component' (maybe because the name is invalid?)" . "Error is:\n". $error); } my @to_primary_keys = $to_component->get_primary_keys(); my %new_args; foreach my $pk (@to_primary_keys) { my $isset = "${pk}_isset"; if ( $self->$isset() ) { $new_args{$pk} = $self->$pk(); } } $new_args{command_interface} = $self->command_interface(); my $to_component_obj; try { $to_component_obj = $to_component->new(%new_args); } otherwise { my $exception = shift; my $ref = ref $self; $Log->exit() if $may_exit; NATE::BaseException->throw( 'Could not build associated object ' . "of type '$to_component' from this state object (of type " . "'$ref'). This is possibly because the state object did " . 'not fill in all of the fields necessary for constructing ' . "a '$to_component' object. Dumper of state object:\n" . NACL::ComponentUtils::Dumper($self) . "Primary keys of '$to_component':\n" . "@to_primary_keys\n" ); }; $Log->exit() if $may_exit; return $to_component_obj; } #----------------------------------------------------------------------------------------------------------------- ##################### _PRIVATE_METHODS ####################### #----------------------------------------------------------------------------------------------------------------- =head2 _handle_commands_returning_common_fields # Using the 7Mode CLI support for StorageDisk as an example my %commands = $pkg->_handle_commands_returning_common_fields( common_fields => [ qw(bay shelf) ], commands => { 'aggr_status_r' => [ qw(rpm type physicalsize chan state zeroed aggregate raidgroup zeroingpercentage container-type) ], 'storage_show_disk' => [ qw(revision vendor model) ] }, preferred_command => 'storage_show_disk', requested_fields => $requested_fields, filter => $filter ); if (exists $commands{'aggr_status_r'}) { # Run aggr status -r ... } if (exists $commands{'storage_show_disk'}) { # Run storage show disk ... } Numerous commands invoked in the CS back-end methods fill in the same fields. To determine which of these commands should be invoked requires knowledge of which fields are filled in by each of the commands. To explain this method in more detail, we'll use the example of the 7Mode CLI implementation for NACL::CS::StorageDisk. In the 7Mode CLI back-end, "aggr status -r" and "storage show disk" need to be run. "aggr status -r" fills in these fields: bay, shelf, rpm, type, physicalsize, chan, state, zeroed, aggregate, raidgroup, zeroingpercentage, container-type. "storage show disk" fils in the fields bay, shelf, revision, vendor, model. As can be seen, the fields bay and shelf are filled in by both commands. Here's a small subset of combinations which should be handled: * All fields required: in thise case both commands should be invoked. * "rpm" required: Only "aggr status -r" should be run. * "revision" required: Only "storage show disk" should be invoked. * "bay" and "rpm" required: Only "aggr status -r" should be run. * "shelf" and "revision" required: Only "storage show disk" should be run. * "bay", "rpm" and "vendor" required: Both commands should be run. * "bay" and "shelf" required: Either command can be run. Preferrably, we should run the command that results in less output (in this case it would be "storage show disk") This method helps handle all of these various combinations. What it returns is a hash with the keys being all of the commands that should be invoked to get the details requested for. By analyzing which keys are present in the hash returned, we can determine which commands to run. =over =item Options =over =item C<< common_fields => \@arr_of_common_fields >> These are the fields which are filled in by all the commands passed into this call. In the above example, "bay" and "shelf" are fields which are filled in by both commands. =item C<< commands => \%commands_hash >> This is a hash-reference where each of the keys is the command name. The value for each of the keys should be an array-reference listing the keys filled in by that command. Note that the common fields should not be listed in these array-references. =item C<< preferred_command => $command >> If we require only the common fields, then we could run either command. Ideally we should run the command that leads to less output. =item requested_fields and filter The requested fields and filter as passed in by the user. =back =back =cut sub _handle_commands_returning_common_fields { $Log->enter() if $may_enter; my $pkg = shift; my %opts = validate_with( params => \@_, spec => { common_fields => { tye => ARRAYREF }, preferred_command => { type => SCALAR }, commands => { type => HASHREF } }, # The other options are those accepted by _want_any_field_of # Let that method validate the other options allow_extra => 1 ); my $common_fields = delete $opts{common_fields}; my $preferred_command = delete $opts{preferred_command}; my $commands = delete $opts{commands}; # By this point, %opts should only have the options which get # passed onto _want_any_field_of my %commands_to_invoke; while ( my ( $command, $fields ) = each %$commands ) { if ( ref $fields eq 'ARRAY' ) { if ($pkg->_want_any_field_of( %opts, fields_filled_by_api => $fields ) ) { $commands_to_invoke{$command} = 1; } } else { $Log->exit() if $may_exit; my $ref = ref($fields) || 'scalar'; NATE::Exceptions::Argument->throw( 'Each of the entries of the ' . "'commands' argument should have been array-refs but one " . "of them was sent as a $ref. Dumper:\n" . Dumper($fields) ); } } # If none of the fields which are specific to the commands are necessary, # we check if any of the common fields are needed. If so, the preferred # command needs to be invoked unless ( keys %commands_to_invoke ) { if ($pkg->_want_any_field_of( %opts, fields_filled_by_api => $common_fields ) ) { $commands_to_invoke{$preferred_command} = 1; } } $Log->exit() if $may_exit; return %commands_to_invoke; } =head2 get_attributes my $hashref = $CS_pkg->get_attributes(); Returns the list of attributes for this package. It returns a hash-reference with the keys being the attribute names and the value being the data type (scalar/array). Example: my $hashref = NACL::CS::ClusterIdentity->get_attribute(); $Log->comment(Dumper $hashref); Output: $VAR1 = { 'contact' => 'scalar', 'location' => 'scalar', 'name' => 'scalar', 'rdb_uuid' => 'scalar', 'serialnumber' => 'scalar', 'uuid' => 'scalar', 'uuid_str' => 'scalar' }; =cut sub get_attributes { $Log->enter() if $may_enter; my ($pkg_or_obj) = @_; my $package = $pkg_or_obj->get_package_name(); my $all_methods = Class::Inspector->methods($package); # Construct into a hash, so we can use single-access calls to determine # if a method exists my %hash; foreach my $elem (@$all_methods) { $hash{$elem} = undef; } # command_interface is an attribute of CS classes, but I'm guessing you # wouldn't want that listed as well delete $hash{command_interface_isset}; my ( @array_attributes, @scalar_attributes ); my $methods_hash; foreach my $method (@$all_methods) { if ( exists $hash{"${method}_isset"} && exists $hash{"${method}_reset"} ) { # Any attribute defined in MethodMaker has the methods # "_isset" and "_reset" installed. Till here # we've determined that this methods is definitely an attribute. # Now we need to determine what type it is. # We do this by invoking the accessor method on the package # name. The corresponding "empty" value is returned. (i.e. # for scalar fields, undef is returned; for array fields, [] # is returned) By analyzing the reference returned, we know what # type of attribute it is. my $value = $package->$method(); my $ref = ref $value; if ( $ref eq 'ARRAY' ) { $methods_hash->{$method} = 'array'; } elsif ( !$ref ) { $methods_hash->{$method} = 'scalar'; } } } $Log->exit() if $may_exit; return $methods_hash; } =head2 get_attributes_of_obj_as_hash my $hashref = $obj->get_attributes_of_obj_as_hash(); Returns the list of attributes associated with that object. It returns a hash-reference with the keys being the attribute names and the value being the value of the corresponding attribute. Example: my $hashref = $obj->get_attributes_of_obj_as_hash(); $Log->comment(Dumper $hashref); Output: $VAR1 = { 'volume' => 'Bogus_volume', 'comment' => 'Original comment', 'aggr_list' => [ \'aggr1\', \'aggr2\' ] }; Api has to be called using object only otherwise it will throw NATE::BaseException error. =cut sub get_attributes_of_obj_as_hash { $Log->enter() if $may_enter; my ($obj) = @_; my $all_attributes; if (blessed($obj)) { my $package = $obj->get_package_name(); $all_attributes = $package->get_attributes(); foreach my $attribute (keys($all_attributes)) { my $obj_attribute = $attribute . '_isset'; ($obj->$obj_attribute() && defined $obj->$attribute()) ? $all_attributes->{$attribute} = $obj->$attribute() : delete $all_attributes->{$attribute}; } } else { NATE::BaseException->throw( $obj . "is not an instance"); } $Log->exit() if $may_exit; return $all_attributes; } =head2 get_hash_of_real_field_names my $attributes_hashref = NACL::CS::VserverNfs->get_attributes(); my @attributes = keys %$attribute_hashref; my %hash = NACL::CS::VserverNfs->get_hash_of_real_field_names( command_interface => $ci, attributes => \@attributes ); Translate from the names of the attributes to the names of the fields as they are in the relevant "show" command's output. See L for a more complete description of what this method does, the options it accepts and the algorithms it employs. Note that the above is the same as doing: my %hash = NACL::ComponentUtils::get_hash_of_real_field_names( package => 'NACL::CS::VserverNfs', command_interface => $ci, attributes => \@attributes ); (This means that when this method is invoked with a CS package name, the C argument is automatically sent as the CS package name with which the method was invoked) =cut sub get_hash_of_real_field_names { $Log->enter() if $may_enter; my ( $pkg, @opts ) = @_; my %hash = NACL::ComponentUtils::get_hash_of_real_field_names( package => $pkg, @opts ); $Log->exit() if $may_exit; return %hash; } =head2 get_real_field_name my $field = NACL::CS::VserverNfs->get_real_field_name( command_interface => $ci, attribute => $attribute ); Translate a CS attributes to the name of the fields as it would be in the relevant "show" command's output. See L for a more complete description of what this method does, the options it accepts and the algorithms it employs. Note that the above is the same as doing: my $field = NACL::ComponentUtils::get_real_field_name( package => 'NACL::CS::VserverNfs', command_interface => $ci, attribute => $attribute ); (This means that when this method is invoked with a CS package name, the C argument is automatically sent as the CS package name with which the method was invoked) =cut sub get_real_field_name { $Log->enter() if $may_enter; my ( $pkg, @opts ) = @_; my $field = NACL::ComponentUtils::get_real_field_name( package => $pkg, @opts ); $Log->exit() if $may_exit; return $field; } =head2 get_all_real_field_names my @real_fields = NACL::CS::VserverNfs->get_all_real_field_names( command_interface => $ci ); The method L returns all the CS attributes for a particular package. This method returns the real field names for all of these attributes. (the "real" field names are those returned in the output of the relevant "show" command, while the CS attributes have hyphens and dots translated to underscores) =cut sub get_all_real_field_names { $Log->enter() if $may_enter; my ( $pkg, @opts ) = @_; my $attributes_hashref = $pkg->get_attributes(); my @attributes = keys %$attributes_hashref; my %hash = $pkg->get_hash_of_real_field_names( @opts, attributes => \@attributes ); my @real_fields = values %hash; $Log->exit() if $may_exit; return @real_fields; } sub DESTROY { } # Sub-classes are expected to override this with the extra fields that can be # provided in the filter but which are not MethodMaker attributes. sub _extra_filter_fields { return []; } # Abstract base class implementation. sub _real_cs { } =head2 _check_if_each_of_correct_type $pkg->_check_if_each_of_correct_type(state_objs => \@state_objs); (Class method only) This method checks if each of the state objects provided is a blessed CS object of type $pkg and throws a C if any of them are not. =over =item Options =over =item C<< state_objs => \@state_objs >> An array-reference of state objects. =back =back =cut sub _check_if_each_of_correct_type { $Log->enter() if $may_enter; my ( $pkg, @args ) = @_; my %opts = validate_with( params => \@args, spec => { state_objs => { type => ARRAYREF } } ); foreach my $state_obj ( @{ $opts{state_objs} } ) { unless ( blessed($state_obj) && $state_obj->isa($pkg) ) { $Log->exit() if $may_exit; NATE::Exceptions::Argument->throw( 'Each of the values of the ' . "'state_objs' argument should be objects of type " . "'$pkg' but one of the values was provided as a " . ref($state_obj) . "'. Dumper:\n" . NACL::ComponentUtils::Dumper($state_obj) ); } } $Log->exit() if $may_exit; } sub _common_validate_spec { NACL::C::Component->_common_validate_spec(@_) } # Why the method from the mix-in doesn't work is one of life's great mysteries. # For now, doing the ugly thing of repeating the code both here and in # CS/ComponentState.pm sub _check_relational_regex_filter { $Log->enter() if $may_enter; my ($pkg_or_obj, @args) = @_; my $ret = NACL::C::Component->_check_relational_regex_filter(@args); $Log->exit() if $may_exit; return $ret; } # If the value contains '*', '|', '..' or spaces and is not contained within # quotes, then it needs to be quoted. # See https://library.netapp.com/ecm/ecm_get_file/ECMP1136871 # See NACL::CS::ComponentState/ONTAP.pm sub _need_to_check_quoting { return 0 } sub _needs_to_be_quoted { return 0; } # Check for presence of fields in requested_fields/filter and return # the ones that are present. This would typically used in check methods # when we want to skip a particular back-end if certain fields are provided # which are not supported by it. sub _invalid_fields_check { $Log->enter() if $may_enter; my ($pkg, @args) = @_; state $spec = { requested_fields => {type => ARRAYREF, default => []}, filter => {type => HASHREF, default => {}}, _fields => {type => ARRAYREF}, }; my %opts = validate_with( params => \@args, spec => $spec, allow_extra => 1, ); my %req_field_hash = map {$_ => 1} @{$opts{requested_fields}}; my @fields_found; foreach my $field (@{$opts{_fields}}) { if (exists $opts{filter}{$field} || exists $req_field_hash{$field}) { push @fields_found, $field; } } $Log->exit() if $may_exit; return @fields_found; } =head2 compare $cs_object->compare( to => $some_other_cs_object, attribute_skip_list => \@skip_list ); (Instance method) Given two Component State objects, compare the values of respective keys between both the objects. Throw an exception if the objects don't match. =over =item Options =over =item C<< to => $some_other_cs_object >> (Mandatory) The Component State object with which the comparision has to be made. =item C<< attribute_skip_list => \@skip_list >> (Optional) If any of attributes are available in one object and not in another, add them to the attribute_skip_list to ignore these keys while comparing. =back =back =cut sub compare { $Log->enter() if $may_enter; my ($self, @args) = @_; my $pkg = ref $self; my $attributes_ref = $pkg->get_attributes(); my @attribute_names = keys %$attributes_ref; my %opts = validate_with( params => \@args, spec => { to => { type => OBJECT, isa => 'NACL::CS::ComponentState' }, #Set of attributes that may be present in one list #but not in other list. Skip them. Optional argument. attribute_skip_list => { type => ARRAYREF, default => [] }, }, ); my $other = $opts{"to"}; #Make sure that both the ComponentState objects being compared are of the #same package. For example, a Vserver cannot be compared to a Volume. if ( $self->get_package_name() ne $other->get_package_name() ) { NACL::Exceptions::VerifyFailure->throw( "Both CS objects belong to different packages". " \nSelf Package name: ".$self->get_package_name(). " \nOther Package name: ".$other->get_package_name() ); } # Filter out attributes in the skip list my $lc = List::Compare->new( $opts{"attribute_skip_list"}, \@attribute_names ); # Get those items which appear only in the second list, but not in the first # one. my @filtered_attribute_names = $lc->get_complement(); foreach my $attribute_name (@filtered_attribute_names) { if ( !defined( $self->$attribute_name() ) && !defined( $other->$attribute_name() ) ) { next; } if ( !defined( $self->$attribute_name() ) || !defined( $other->$attribute_name() ) ) { NACL::Exceptions::VerifyFailure->throw( "One of the attributes is undefined". " \nAttribute: ".$attribute_name. " \nSelf attribute value: ".$self->$attribute_name(). " \nOther attribute value: ".$other->$attribute_name() ); } # Handle non scalar attributes if ( $attributes_ref->{$attribute_name} eq "array" ) { my @self = $self->$attribute_name(); my @other = $other->$attribute_name(); $lc = List::Compare->new(\@self, \@other); if ( !$lc->is_LequivalentR() ) { NACL::Exceptions::VerifyFailure->throw( "Failure case: The attributes are of type array and the arrays are not equivalent.". " \nAttribute: ".$attribute_name. " \nSelf attribute value: ".Dumper(\@self). " \nOther attribute value: ".Dumper(\@other) ); } else { # Both the arrays are equivalent. Proceed to next attribute. next; } } if ( $self->$attribute_name() ne $other->$attribute_name() ) { NACL::Exceptions::VerifyFailure->throw( "Failure case: The attribute values don't match.". " \nAttribute: ".$attribute_name. " \nSelf attribute value: ".$self->$attribute_name(). " \nOther attribute value: ".$other->$attribute_name() ); } } $Log->exit() if $may_exit; return 1; } =head2 _get_pk_string Generates primary key string to create a bijection between the two CS objects. This primary key string helps in identifying each record of the CS list uniquely. =cut sub _get_pk_string { my ($pkg, $component_state) = @_; my $component = $component_state->get_component_instance(); my $pk_string = $component->get_primary_key_string(); return $pk_string; } =head2 list_compare $pkg->list_compare( first_cs_list => \@first_cs_list, second_cs_list => \@second_cs_list, get_pk_string => \&_get_pk_string, attribute_skip_list => \@skip_list, ); (Class method) Given two lists of Component State objects, compare all the CS objects of one list with the other. Throw an exception if any of the objects don't match. =over =item Options =over =item C<< first_cs_list => \@first_cs_list >> (Mandatory) First CS objects' list to be compared =item C<< second_cs_list => \@second_cs_list >> (Mandatory) Second CS objects' list to be compared =item C<< get_pk_string >> (Optional) The user can pass a reference to his own get_primary_string function if the default get_primary_string isn't suitable. For example, NACL::CS::VolumeQuotaReport doesn't have a corresponding Component object. In this case, the above _get_pk_string method fails. So, a reference to an implemented method needs to be provided. Refer to NACL/UnitTest/C/Quota.thpl for detailed usage. =item C<< attribute_skip_list => \@skip_list >> (Optional) If any of attributes are available in one object and not in another, add them to the attribute_skip_list to ignore these keys while comparing. =back =back =cut sub list_compare { $Log->enter() if $may_enter; my ($pkg, @args) = @_; my %opts = validate_with( params => \@args, spec => { first_cs_list => { type => ARRAYREF }, second_cs_list => { type => ARRAYREF }, get_pk_string => { type => CODEREF, default => \&_get_pk_string }, attribute_skip_list => { type => ARRAYREF, default => [] }, }, ); my @first_list = @{$opts{first_cs_list}}; my @second_list = @{$opts{second_cs_list}}; my %comparison_hash = (); my $get_pk_string_ref = $opts{get_pk_string}; foreach my $component_state (@first_list) { my $pk_string = $get_pk_string_ref->($pkg, $component_state); if ( exists $comparison_hash{$pk_string}->{"first"} ) { NACL::Exceptions::VerifyFailure->throw( "Primary Key String Collision: $pk_string" ); } $comparison_hash{$pk_string}->{"first"} = $component_state; } foreach my $component_state (@second_list) { my $pk_string = $get_pk_string_ref->($pkg, $component_state); if ( exists $comparison_hash{$pk_string}->{"second"} ) { NACL::Exceptions::VerifyFailure->throw( "Primary Key String Collision: $pk_string" ); } $comparison_hash{$pk_string}->{"second"} = $component_state; } foreach my $compare_spec (values %comparison_hash) { if ( !defined ($compare_spec->{first}) || !defined ($compare_spec->{second} ) ) { NACL::Exceptions::VerifyFailure->throw( "Dont have two components to compare: ".Dumper($compare_spec) ); } $compare_spec->{first}->compare( to => $compare_spec->{second}, attribute_skip_list => $opts{attribute_skip_list}, ); } $Log->exit() if $may_exit; } 1;