# Prepare.pm: Class Used for Objects to Prepare the Setup

package IRDA::Prepare;

# $Id: Prepare.pm,v 1.11 2015/05/08 18:25:43 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/IRDA/Prepare.pm,v 1.11 2015/05/08 18:25:43 RDA Exp $
#
# Change History
# 20150508  MSC  Improve the documentation.

=head1 NAME

IRDA::Prepare - Class Used for Objects to Prepare the Setup

=head1 SYNOPSIS

 require IRDA::Prepare;

=head1 DESCRIPTION

The objects of the C<IRDA::Prepare> class are used to prepare the setup of
the Remote Diagnostic Agent (RDA) data collection.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::File;
  use IO::Handle;
  use RDA::Text qw(debug get_string);
  use RDA::Object::Item;
  use RDA::Object::Rda;
}

# Define the global public variables
use vars qw($STRINGS $VERSION @ISA);
$VERSION = sprintf('%d.%02d', q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/);
@ISA     = qw(Exporter);

# Define the global private constants
my $MOD = '[A-Z][A-Z\d]*:DC[a-z][a-z\d]*';

# Define the global private variables
my %tb_req = (
  HASH => '_hsh',
  MAP  => '_map',
  RULE => '_req',
  );

# Report the module version number
sub Version
{ return $VERSION;
}

=head2 S<$h = IRDA::Prepare-E<gt>new($agent,$version,$trace)>

The object constructor. This method enables you to specify the agent reference,
the call interface version, and the trace level as extra arguments.

C<IRDA::Prepare> is represented by a blessed hash reference. The following
special keys are used:

=over 16

=item S<  B<'agt' > > Reference to the agent object

=item S<  B<'col' > > Reference to the collector object

=item S<  B<'err' > > Error buffer

=item S<  B<'trc' > > Trace indicator

=item S<  B<'ver' > > Call interface version

=item S<  B<'_chg'> > Setting changes hash

=item S<  B<'_def'> > Plug-in definitions

=item S<  B<'_dsc'> > Discovery rule definitions

=item S<  B<'_fam'> > Prepare compatibility type hash

=item S<  B<'_hsh'> > Hash definitions

=item S<  B<'_inp'> > Request parameters

=item S<  B<'_lvl'> > Setting level alteration hash

=item S<  B<'_map'> > Mapping definitions

=item S<  B<'_mod'> > List of modules to collect

=item S<  B<'_prp'> > Prepare value hash

=item S<  B<'_req'> > Requirement rule definitions

=item S<  B<'_set'> > Reference to the SETUP item object

=item S<  B<'_sys'> > Reference to the system view control object

=item S<  B<'_tgt'> > Prepare targets hash

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my ($cls, $agt, $ver, $trc) = @_;
  my ($col);

  # Create the object and return its reference
  $col = $agt->get_collector;
  return bless {
    agt  => $agt,
    col  => $col,
    err  => [],
    trc  => $trc,
    ver  => $ver,
    _def => {},
    _dsc => {dft => [], sel => [], seq => []},
    _inp => {},
    _lvl => {},
    _map => {},
    _mod => [],
    _req => {},
    _set => $col->get_info('set'),
    _sys => $agt->get_system,
    }, ref($cls) || $cls;
}

=head2 S<$h-E<gt>apply_selections($request,$config)>

This method loads the request parameters, discovers the rule selection settings,
builds with the values from the list of RDA modules to collect, and sets the
module settings linked to the rule selections.

=cut

sub apply_selections  ## no critic (Complex)
{ my ($slf, $req, $cnf) = @_;
  my ($arg, $cnt, $met, $nam, $rul, $set, $top, $trc, $val, %mod);

  $set = $slf->{'_set'};
  $top = $slf->{'_dsc'};
  $trc = $slf->{'trc'};

  # Tie values
  $set->set_value('T_PRP', {});
  $set->set_value('T_REQ', $req);
  $slf->{'_prp'} = $set->tie_value('T_PRP');
  $slf->{'_inp'} = $set->tie_value('T_REQ');

  # Consider default modules
  %mod = map {$_ => 0} @{$top->{'dft'}};

  # Apply selection rules
  foreach my $sel (@{$top->{'sel'}})
  { # Find the rule selection setting and discover its value
    ($nam, $met, $arg) = @{$sel};
    debug("[Prepare/Selection] Discover '$nam'") if $trc;
    $rul = $slf->discover_value($nam, $met, $arg);
    next unless defined($rul) && length($rul);

    # Load the modules in the module list and set the settings
    if (exists($slf->{'_req'}->{$rul}))
    { debug("[Prepare/Selection] Apply rule '$rul' for '$nam'") if $trc;
      $rul = $slf->{'_req'}->{$rul};

      # Check type compatibility
      if (exists($rul->{'fam'}))
      { if (exists($slf->{'_fam'}))
        { $cnt = 0;
          foreach my $key (keys(%{$slf->{'_fam'}}))
          { if (exists($rul->{'fam'}->{$key}))
            { ++$cnt;
            }
            else
            { delete($slf->{'_fam'}->{$key})
            }
          }
          die get_string('INCOMPATIBLE') unless $cnt;
        }
        else
        { $slf->{'_fam'} = {%{$rul->{'fam'}}};
        }
      }

      # Merge prepare values
      if (exists($rul->{'prp'}))
      { foreach my $key (keys(%{$rul->{'prp'}}))
        { $slf->{'_prp'}->{$key} = $rul->{'prp'}->{$key};
        }
      }

      # Merge module lists
      for (@{$rul->{'mod'}})
      { $mod{$_} = 1;
      }

      # Merge setting changes
      if (exists($rul->{'chg'}))
      { foreach my $key (keys(%{$rul->{'chg'}}))
        { $val = $rul->{'chg'}->{$key};
          $slf->{'_chg'}->{$key} = $val
            unless $key =~ m{(^|[\./])([DF]_\w+)$}
                && RDA::Object::Item->validate($2, $val);
        }
      }

      # Merge setting level alterations
      if (exists($rul->{'lvl'}))
      { foreach my $mod (keys(%{$rul->{'lvl'}}))
        { foreach my $key (keys(%{$rul->{'lvl'}->{$mod}}))
          { $val = $rul->{'lvl'}->{$mod}->{$key};
            $slf->{'_lvl'}->{$mod}->{$key} = $val
              unless exists($slf->{'_lvl'}) &&  ## no critic (Unless)
                     exists($slf->{'_lvl'}->{$mod}) &&
                     exists($slf->{'_lvl'}->{$mod}->{$key}) &&
                     $val < $slf->{'_lvl'}->{$mod}->{$key};
          }
        }
      }

      # Merge prepare targets
      if (exists($rul->{'tgt'}))
      { foreach my $key (keys(%{$rul->{'tgt'}}))
        { $slf->{'_tgt'}->{$key} = $rul->{'tgt'}->{$key};
        }
      }
    }
    else
    { debug("[Prepare/Selection] Skip rule '$rul' for '$nam'") if $trc;
    }
  }

  # Amend preparation values
  if (ref($cnf) eq 'HASH')
  { foreach my $key (keys(%{$slf->{'_prp'}}))
    { next unless defined($val = $cnf->{"SETTING_$key"});
      $slf->{'_prp'}->{$key} = $val;
      debug("[Prepare/Selection] Assign '$val' to '$key'") if $trc;
    }
  }

  # Generate the module list
  $slf->{'_mod'} = [sort keys(%mod)];
  debug('[Prepare/Selection] Module list: ',
    join(q{,}, @{$slf->{'_mod'}})) if $trc;

  # Untie prepare values
  $set->untie_value('T_PRP');
  $set->untie_value('T_REQ');

  # Return the object reference
  return $slf;
}

=head2 S<$h-E<gt>check_rules($flag)>

This method checks the rule files for completeness and correctness.

=cut

sub check_rules  ## no critic (Complex)
{ my ($slf, $flg) = @_;
  my ($cnt, $dsp, $lgt, $max, $met, $nam, $sep, $tbl, @tbl, %bad, %tbl);

  $cnt = 0;
  $dsp = $slf->{'agt'}->get_display;
  $sep = q{};

  # Report syntax errors
  if ($cnt = @{$slf->{'err'}})
  { $dsp->dsp_line(join("\n  ", 'Errors detected in rule files',
      @{$slf->{'err'}}));
    $sep = "\n";
  }

  # Check the presence of mandatory informations
  unless (@{$slf->{'_dsc'}->{'sel'}})
  { $cnt++;
    $dsp->dsp_line($sep.'Missing selectors');
    $sep = "\n";
  }
  unless (keys(%{$slf->{'_req'}}))
  { $cnt++;
    $dsp->dsp_line($sep.'Missing requirement rules');
    $sep = "\n";
  }

  # Check the module existence
  %bad = ();
  %tbl = map {$_ => 1} $slf->{'agt'}->get_content->get_modules('DC');
  foreach my $mod (@{$slf->{'_dsc'}->{'dft'}})
  { push(@{$bad{$mod}}, 'Default') unless exists($tbl{$mod});
  }
  foreach my $mod (@{$slf->{'_dsc'}->{'seq'}})
  { push(@{$bad{$mod}}, 'Discovery') unless exists($tbl{$mod});
  }
  foreach my $rul (sort (keys(%{$slf->{'_req'}})))
  { foreach my $mod (@{$slf->{'_req'}->{$rul}->{'mod'}})
    { push(@{$bad{$mod}}, "[RULE.$rul]") unless exists($tbl{$mod});
    }
  }
  if (@tbl = sort keys(%bad))
  { $cnt++;
    $dsp->dsp_line($sep.'Invalid Modules:');
    foreach my $mod (@tbl)
    { $dsp->dsp_line(sprintf('  %-17s  ', $mod), join(', ', @{$bad{$mod}}));
    }
    $sep = "\n";
  }

  # Check the plug-in existence
  %bad = ();
  $tbl = $slf->{'_def'};
  foreach my $rec (@{$slf->{'_dsc'}->{'sel'}})
  { ($nam, $met) = @{$rec};
    push(@{$bad{$met}}, $nam) unless exists($tbl->{$met});
  }
  foreach my $mod (@{$slf->{'_dsc'}->{'seq'}})
  { next unless exists($slf->{'_dsc'}->{'mod'}->{$mod});
    foreach my $rec (@{$slf->{'_dsc'}->{'mod'}->{$mod}})
    { ($nam, $met) = @{$rec};
      push(@{$bad{$met}}, "[$mod]$nam") unless exists($tbl->{$met});
    }
  }
  if (@tbl = sort keys(%bad))
  { $cnt++;
    $dsp->dsp_line($sep.'Missing Plugins:');
    $max = 0;
    foreach my $met (@tbl)
    { $max = $lgt if ($lgt = length($met)) > $max;
    }
    foreach my $met (@tbl)
    { $dsp->dsp_line(sprintf('  %-*s  ', $max, $met).join(', ', @{$bad{$met}}));
    }
    $sep = "\n";
  }

  # Check mapping/rule relationship
  if ($flg)
  { my (%map, %sel);

    # Build table with selection settings
    %sel = map {$_->[0] => 1} @{$slf->{'_dsc'}->{'sel'}};

    # Build table with selection setting mappings
    foreach my $map (keys(%{$slf->{'_map'}}))
    { next unless exists($sel{$map});
      foreach my $val (values(%{$slf->{'_map'}->{$map}->{'str'}}))
      { $map{$val} = 0;
      }
      foreach my $rec (@{$slf->{'_map'}->{$map}->{'pat'}})
      { $map{$rec->[0]} = 0;
      }
    }

    # Detect map values without corresponding rules
    if (@tbl = grep{!exists($map{$_})} sort keys(%{$slf->{'_req'}}))
    { $cnt++;
      $dsp->dsp_string($sep.'Map values with no associated rule: ',
        join(', ', @tbl));
      $sep = "\n";
    }

    # Detect unused rules
    if (@tbl = grep{!exists($slf->{'_req'}->{$_})} sort keys(%map))
    { $cnt++;
      $dsp->dsp_string($sep.'Unmapped rules: ', join(', ', @tbl));
      $sep = "\n";
    }
  }

  # Indicate the check results
  return $cnt;
}

=head2 S<$h-E<gt>discover_settings>

This method discovers all module settings.

=cut

sub discover_settings
{ my ($slf) = @_;
  my ($arg, $cnd, $met, $nam, $prp, $set, $top, $trc, %tbl);

  $set = $slf->{'_set'};
  $prp = $slf->{'_prp'};
  $top = $slf->{'_dsc'};
  $trc = $slf->{'trc'};
  %tbl = map {$_ => 1} @{$slf->{'_mod'}};

  foreach my $mod (@{$top->{'seq'}})
  { next unless exists($tbl{$mod}) && exists($top->{'mod'}->{$mod});
    debug("[Prepare/Discover] Module '$mod'") if $trc;
    foreach my $rec (@{$top->{'mod'}->{$mod}})
    { ($nam, $met, $arg, $cnd) = @{$rec};
      if ($set->is_defined($nam))
      { debug("[Prepare/Discover] Skip defined setting '$nam'")
          if $trc;
      }
      elsif (defined($cnd) && !(exists($prp->{$cnd}) && $prp->{$cnd}))
      { debug("[Prepare/Discover] Skip conditional setting '$nam'")
          if $trc;
      }
      else
      { debug("[Prepare/Discover] Discover setting '$nam'")
          if $trc;
        $slf->discover_value($nam, $met, $arg);
      }
    }
  }
  return;
}

=head2 S<$h-E<gt>discover_value($name,$mechanism[,$argument])>

This method retrieves the prepare value using the appropriate mechanism
when the value is not known yet.

It returns the prepare value.

=cut

sub discover_value
{ my ($slf, $nam, $met, $arg) = @_;
  my ($tbl, $trc, $val);

  $tbl = $slf->{'_prp'};
  $trc = $slf->{'trc'};
  if(exists($tbl->{$nam}))
  { $val = $tbl->{$nam};
    debug("[Prepare/Discover] '$nam' already defined ($val)") if $trc;
  }
  elsif (exists($slf->{'_def'}->{$met}))
  { eval {
      &{$slf->{'_def'}->{$met}}($slf, $nam, $arg);
      };
    if ($@ && $trc)
    { $met .= "($arg)" if defined($arg);
      debug("[Prepare/Discover] Error when using '$met' for '$nam'\n$@");
    }
    $val = $tbl->{$nam};
    debug("[Prepare/Discover] $nam='$val'") if $trc && defined($val);
  }
  else
  { debug(
      "[Prepare/Discover] Missing discovery mechanism '$met' for '$nam'")
      if $trc;
  }
  return $val;
}

=head2 S<$h-E<gt>get_changes([$default])>

This method returns the setting changes as a hash. It returns the default
value when there are no setting changes.

=cut

sub get_changes
{ my ($slf, $dft) = @_;

  return exists($slf->{'_chg'}) ? $slf->{'_chg'} : $dft;
}

=head2 S<$h-E<gt>get_hash_value($name,$key[,$default])>

This method returns the value of the specified hash key. It returns the default
value when the hash or the key is not defined.

=cut

sub get_hash_value
{ my ($slf, $nam, $key, $dft) = @_;

  if (!exists($slf->{'_hsh'}->{$nam}))
  { debug("[Prepare/Hash] No hash values for '$nam'")
      if $slf->{'trc'};
  }
  elsif (exists($slf->{'_hsh'}->{$nam}->{$key}))
  { $dft = $slf->{'_hsh'}->{$nam}->{$key};
    debug("[Prepare/Hash] Value of '$key' in '$nam': '$dft'")
      if $slf->{'trc'};
  }
  else
  { debug("[Prepare/Hash] Key '$key' not defined in '$nam'")
      if $slf->{'trc'};
  }
  return $dft;
}

=head2 S<$h-E<gt>get_levels([$default])>

This method returns the setting level alterations as a hash.

=cut

sub get_levels
{ return shift->{'_lvl'};
}

=head2 S<$h-E<gt>get_modules>

This method returns the list of selected modules.

=cut

sub get_modules
{ return @{shift->{'_mod'}};
}

=head2 S<$h-E<gt>get_names>

This method returns the name list.

=cut

sub get_names
{ return ('Irda');
}

=head2 S<$h-E<gt>get_prepare_value($name[,$default])>

This method returns the value for a prepare parameter or an undefined value
when it does not find such a parameter in the request file.

=cut

sub get_prepare_value
{ my ($slf, $nam, $dft) = @_;

  return exists($slf->{'_prp'}->{$nam}) ? $slf->{'_prp'}->{$nam} : $dft;
}

=head2 S<$h-E<gt>get_request_value($name[,$default])>

This method returns the value for a request parameter or an undefined value
when it does not find such a parameter in the request file.

=cut

sub get_request_value
{ my ($slf, $nam, $dft) = @_;

  return exists($slf->{'_inp'}->{$nam}) ? $slf->{'_inp'}->{$nam} : $dft;
}

=head2 S<$h-E<gt>get_system>

This method returns a reference to the system view.

=cut

sub get_system
{ return shift->{'_sys'};
}

=head2 S<$h-E<gt>get_targets([$default])>

This method returns the prepare targets as a hash. It returns the default
value when there are no prepare targets.

=cut

sub get_targets
{ my ($slf, $dft) = @_;

  return exists($slf->{'_tgt'}) ? $slf->{'_tgt'} : $dft;
}

=head2 S<$h-E<gt>get_trace>

This method indicates whether tracing is requested.

=cut

sub get_trace
{ return shift->{'trc'};
}

=head2 S<$h-E<gt>get_types([$default])>

This method returns the prepare compatibility hash. It returns the default
value when the selected rules do not contain any type restrictions.

=cut

sub get_types
{ my ($slf, $dft) = @_;

  return exists($slf->{'_fam'}) ? $slf->{'_fam'} : $dft;
}

=head2 S<$h-E<gt>load_plugins>

This method loads the discovery mechanism definitions from plug-ins.

=cut

sub load_plugins
{ my ($slf) = @_;
  my ($cls, $dir, $trc, $ver);

  $trc = $slf->{'trc'};
  $ver = uc($slf->{'ver'});
  $dir = $slf->{'agt'}->get_config->get_dir('D_RDA_INC', "IRDA/$ver");
  opendir(PLG, $dir) or die get_string('ERR_PLUGINS', $dir, $!);
  foreach my $pkg (readdir(PLG))
  { next unless $pkg =~ m/^(\w)(\w*)\.pm$/i;

    # Load the plug-in
    $cls = q{IRDA::}.$ver.q{::}.uc($1).lc($2);
    eval qq{require $cls};
    die get_string('ERR_LOAD', $cls, $@) if $@;
    debug("[Prepare/Plugin] $pkg loaded") if $trc;

    # Register the discovery mechanisms
    $cls->load($slf->{'_def'});
  }
  closedir(PLG);

  # Return the object reference
  return $slf;
}

=head2 S<$h-E<gt>load_rules($slf[,$verbose])>

This method loads the rule files.

=cut

sub load_rules  ## no critic (Complex)
{ my ($slf, $verbose) = @_;
  my ($buf, $cfg, $err, $fil, $grp, $ifh, $key, $lin, $msg, $sct, $str, $top,
      $trc, $val, $ver);

  # Determine the configuration directory
  $cfg = $slf->{'agt'}->get_config;
  $ifh = IO::File->new;
  $trc = $slf->{'trc'};
  $ver = lc($slf->{'ver'});

  # Determine the map definitions and the module requirement rules
  debug('[Prepare/Rules] Loading maps and requirement rules ...') if $trc;
  $fil = $cfg->get_file('D_RDA_DFW', "$ver/reqrul.cfg");
  $ifh->open("<$fil") or die get_string('ERR_RULES', $fil, $!);
  $lin = 0;
  $buf = $grp = $sct = q{};
  $slf->{'_hsh'} = {};
  $slf->{'_map'} = {};
  $slf->{'_req'} = {};
  while (<$ifh>)
  { # Trim spaces and join continuation lines
    ++$lin;
    s/^\s+//;
    s/[\n\r]+$//;
    $buf .= $_;
    next if $buf =~ s/\\$//;
    $buf =~ s/\s+$//;

    # Treat the line
    eval {
      if ($buf =~ m/^\[(HASH|MAP|RULE)\.(.*)\]/)
      { ($grp, $sct, $top) = ($1, $2, $slf->{$tb_req{$1}}->{$2} = {});
      }
      elsif ($grp eq 'HASH')
      { if ($buf =~ s/^(\w+(\.\w+)*)=(['"])(.*?)\3\s*//)
        { $key = $1;
          $val = $4;
          $val =~ s/\\([0-3][0-7]{2}|0x[0-9A-Fa-f]{2})/chr(oct($1))/eg;
          $top->{$key} = $val;
        }
        else
        { die get_string('BAD_DECLARATION')
            unless $buf =~ m/^\s*(#.*)?/;
        }
      }
      elsif ($grp eq 'MAP')
      { if ($buf =~ s/^(\w+(\.\w+)*)=//)
        { $key = $1;
          while ($buf)
          { if ($buf =~ s/^'(.*?)'//)
            { $val = $1;
              $val =~ s/\\([0-3][0-7]{2}|0x[0-9A-Fa-f]{2})/chr(oct($1))/eg;
              $top->{'str'}->{$val} = $key;
              last unless $buf =~s/^,//;
            }
            elsif ($buf =~ s/^"(.*?)"//)
            { push(@{$top->{'pat'}}, [$key, qr/$1/i]) if length($1);
              last unless $buf =~s/^,//;
            }
            else
            { last if $buf =~ m/^\s*(#.*)?$/;
              die get_string('BAD_VALUE');
            }
          }
        }
        else
        { die get_string('BAD_DECLARATION')
            unless $buf =~ m/^\s*(#.*)?$/;
        }
      }
      elsif ($grp eq 'RULE')
      { if ($buf =~ s/^LVL\/([A-Z][A-Z\d]*:\w+)\/(\w+)\s*=\s*(\d+)\s*//)
        { $top->{'lvl'}->{$1}->{$2} = $3;
          die get_string('BAD_VALUE') unless $buf =~ m/^\s*(#.*)?$/;
        }
        elsif ($buf =~ s/^PRP\/(\w+)\s*=\s*//)
        { $key = lc($1);
          $val = RDA::Object::Item::decode_value($slf, \$buf, 1);
          die get_string('BAD_VALUE') unless $buf =~ m/^\s*(#.*)?$/;
          $top->{'prp'}->{$key} = $val;
        }
        elsif ($buf =~ s/^TGT\/((\w+\.)*[A-Z]{2,}_\w*P\d+)\s*=\s*//)
        { $key = uc($1);
          $val = RDA::Object::Item::decode_value($slf, \$buf, 1);
          die get_string('NO_HASH')   unless ref($val) eq 'HASH';
          die get_string('BAD_VALUE') unless $buf =~ m/^\s*(#.*)?$/;
          $top->{'tgt'}->{$key} = $val;
        }
        elsif ($buf =~ s/^((\w+\/)?(\w+\.)*([DF]_\w+))\s*=\s*//)
        { $key = uc($1);
          $str = uc($4);
          $val = RDA::Object::Item::decode_value($slf, \$buf, 1);
          die get_string('BAD_VALUE') unless $buf =~ m/^\s*(#.*)?$/;
          $top->{'chg'}->{$key} = $val;
        }
        elsif ($buf =~ s/^((\w+\/)?(\w+\.)*([A-Z]_\w+))\s*=\s*//)
        { $key = uc($1);
          $str = uc($4);
          $val = RDA::Object::Item::decode_value($slf, \$buf, 1);
          die $msg if ($msg = RDA::Object::Item->validate($str, $val));
          die get_string('BAD_VALUE') unless $buf =~ m/^\s*(#.*)?$/;
          $top->{'chg'}->{$key} = $val;
        }
        elsif ($buf =~ s/^\*=($MOD(,$MOD)*)//)
        { $top->{'mod'} = [split(/,/, $1)];
          die get_string('BAD_VALUE') unless $buf =~ m/^\s*(#.*)?$/;
        }
        elsif ($buf =~ s/^\@\s*=\s*((\w+:)?\w+(\s*,\s*(\w+:)?\w+)*)//)
        { $top->{'_fam'} = {map {$_ => 1} split(/\s*,\s*/, $1)};
          die get_string('BAD_VALUE') unless $buf =~ m/^\s*(#.*)?$/;
        }
        else
        { die get_string('BAD_DECLARATION')
            unless $buf =~ m/^\s*(#.*)?$/;
        }
      }
      else
      { die get_string('BAD_DECLARATION')
          unless $buf =~ m/^\s*(#.*)?$/;
      }
      };
    $buf = q{};

    # Store errors
    if ($err = $@)
    { $err =~ s/[\n\r\s]+$//;
      push(@{$slf->{'err'}}, get_string('Error', $err, $fil, $lin));
    }
  }
  $ifh->close;

  # Determine the rule selection setting and the module discovery rules
  debug('[Prepare/Rules] Loading discovery rules ...') if $trc;
  $fil = $cfg->get_file('D_RDA_DFW', "$ver/dscrul.cfg");
  $ifh->open("<$fil") or die get_string('ERR_DISCOVERY', $fil, $!);
  $err = $slf->{'err'};
  $slf->{'_dsc'} = $top = {dft => [], sel => [], seq => []};
  $lin = 0;
  $buf = $sct = q{};
  while (<$ifh>)
  { # Trim spaces and join continuation lines
    ++$lin;
    s/^\s+//;
    s/[\n\r]+$//;
    $buf .= $_;
    next if $buf =~ s/\\$//;
    $buf =~ s/\s+$//;

    # Treat the line
    eval {
      ## no critic (Capture)
      if ($buf =~ m/^\[($MOD)\]/)
      { push(@{$top->{'seq'}}, $sct = $1);
      }
      elsif ($buf =~ m/^\*=($MOD(,$MOD)*)*/)
      { die get_string('BAD_NESTING') if $sct;
        push(@{$top->{'dft'}}, split(/,/, $1));
      }
      elsif ($buf !~ m/^((\w+\/)?(\w+\.)*\w+)=((\w+)\?)?(\w+)(\((\w+)\))?$/)
      { die get_string('BAD_DECLARATION')
          unless $buf =~ m/^\s*(#.*)?$/;
      }
      elsif ($sct)
      { push(@{$top->{'mod'}->{$sct}}, [$1, $6, $8, $5]);
      }
      else
      { push(@{$top->{'sel'}}, [$1, $6, $8]);
        die get_string('BAD_CONDITION') if $5;
      }
      };
    $buf = q{};

    # Store errors
    if ($err = $@)
    { $err =~ s/[\n\r\s]+$//;
      push(@{$slf->{'err'}}, get_string('Error', $err, $fil, $lin));
    }
  }
  $ifh->close;

  # Report the errors
  if ($trc && @{$slf->{'err'}})
  { debug('[Prepare/Rules] Errors:');
    for (@{$slf->{'err'}})
    { debug($_);
    }
  }

  # Return the object reference
  return $slf;
}

=head2 S<$h-E<gt>map_value($name,$value)>

This method transforms the setting value using the mapping rules. It returns
the original value when no mapping rules are associated with that variable. It
returns an empty string when no rules are applicable.

=cut

sub map_value
{ my ($slf, $nam, $old) = @_;
  my ($new, $top, $trc);

  $trc = $slf->{'trc'};
  debug("[Prepare/Map] Map '$old' for '$nam'") if $trc;

  # Abort if no rules exist for the setting
  unless (exists($slf->{'_map'}->{$nam}))
  { debug("[Prepare/Map] No mapping rules for '$nam'") if $trc;
    return $old;
  }

  # Map with a fixed string
  $top = $slf->{'_map'}->{$nam};
  if (exists($top->{'str'}->{$old}))
  { $new = $top->{'str'}->{$old};
    debug("[Prepare/Map] String mapping for '$nam': '$old' -> '$new'")
      if $trc;
    return $new;
  }

  # Search for a pattern
  foreach my $rec (@{$top->{'pat'}})
  { if ($old =~ $rec->[1])
    { $new = $rec->[0];
      debug("[Prepare/Map] Pattern mapping for '$nam': '$old' -> '$new'")
        if $trc;
      return $new;
    }
  }

  # Report no matches
  debug("[Prepare/Map] Nothing mapped for '$nam': '$old'") if $trc;
  return q{};
}

=head2 S<$h-E<gt>set_change($key,$value)>

This method adds a setting change.

=cut

sub set_change
{ my ($slf, $key, $val) = @_;

  $slf->{'_chg'}->{$key} = $val if defined($key);
  return;
}

=head2 S<$h-E<gt>set_value($key,$value)>

This method adds a prepare_value.

=cut

sub set_value
{ my ($slf, $key, $val) = @_;

  $slf->{'_prp'}->{uc($key)} = $val if defined($key);
  return;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Object::Collect|RDA::Object::Collect>,
L<RDA::Object::Content|RDA::Object::Content>,
L<RDA::Object::Item|RDA::Object::Item>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Object::View|RDA::Object::View>,
L<RDA::Text|RDA::Text>

=head1 COPYRIGHT NOTICE

Copyright (c) 2002, 2016, Oracle and/or its affiliates. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle and Java are registered trademarks of Oracle and/or its
affiliates. Other names may be trademarks of their respective owners.

=cut