package RDA::Module;

# $Id: Module.pm,v 1.50 2009/05/03 20:32:14 mschenke Exp $
# ARCS: $Header: /u02/webapps/workbench/cvs/RDA_4/src/scripting/lib/RDA/Module.pm,v 1.50 2009/05/03 20:32:14 mschenke Exp $
#
# Change History
# 20090503  MSC  Add the 'trg' setting.

=head1 NAME

RDA::Module - Class Used for Objects to Setup Modules

=head1 SYNOPSIS

require RDA::Module;

=head1 DESCRIPTION

The objects of the C<RDA::Module> class are used to manage module setup.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use File::Spec;
  use RDA::Setting;
}

# Define the global public variables
use vars qw($VERSION);
$VERSION = sprintf("%d.%02d", q$Revision: 1.50 $ =~ /(\d+)\.(\d+)/);

# Define the global private constants
my $PRE_HDR = '  ';
my $PRE_TXT = '    ';

# Define the global private variables
my %tb_def = (
  '_rpt' => ['_SETTINGS', 'T', 'Settings to include in the setting report'],
  '_tmp' => ['_TEMP',     'T', 'Predefined temporary settings'],
  '-trg' => ['_TRIGGER',  'T', 'Modules to trigger'],
  '_ttl' => ['_TITLE',    'T', 'Title for a setting report section'],
  );
my %tb_mod = (
  'col' => ['_col', \&_load_val],
  'dsc' => ['_dsc', \&_load_val],
  'env' => ['_env', \&_load_list],
  'fam' => ['_fam', \&_load_list],
  'inv' => ['_inv', \&_load_list],
  'man' => ['_man', \&_load_text],
  'req' => ['_req', \&_load_list],
  'rpt' => ['_rpt', \&_load_val],
  'tmp' => ['_tmp', \&_load_val],
  'trg' => ['_trg', \&_load_list],
  'ttl' => ['_ttl', \&_load_val],
  'var' => ['_var', \&_load_list],
  );
my %tb_var = (
  'aft' => ['_aft', \&_load_text],
  'alt' => ['_alt', \&_load_list],
  'bef' => ['_bef', \&_load_text],
  'clr' => ['_clr', \&_load_val],
  'col' => ['_col', \&_load_val],
  'dft' => ['_dft', \&_load_val],
  'dsc' => ['_dsc', \&_load_val],
  'dup' => ['_dup', \&_load_val],
  'end' => ['_end', \&_load_val],
  'err' => ['_err', \&_load_text],
  'fam' => ['_fam', \&_load_list],
  'hlp' => ['_hlp', \&_load_text],
  'inp' => ['_inp', \&_load_val],
  'itm' => ['_itm', \&_load_val],
  'lvl' => ['_lvl', \&_load_val],
  'man' => ['_man', \&_load_text],
  'mnu' => ['_mnu', \&_load_val],
  'nam' => ['_nam', \&_load_name],
  'one' => ['_one', \&_load_val],
  'opt' => ['_opt', \&_load_val],
  'ref' => ['_ref', \&_load_val],
  'rsp' => ['_rsp', \&_load_val],
  'sep' => ['_sep', \&_load_val],
  'val' => ['_val', \&_load_valid],
  'typ' => ['_typ', \&_load_type],
  'var' => ['_var', \&_load_list],
  'vis' => ['_vis', \&_load_val],
  );

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

=head2 S<$h = RDA::Module-E<gt>new($name,$dir,$agt)>

The object constructor. It takes the module name, module directory, and the
agent reference as arguments.

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

=over 12

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

=item S<    B<'_col'> > Indicates if the data collection should be done

=item S<    B<'_def'> > Setting definition hash

=item S<    B<'_dir'> > Module directory

=item S<    B<'_dsc'> > Description string

=item S<    B<'_err'> > Number of load errors

=item S<    B<'_env'> > List of environment variables to import

=item S<    B<'_evt'> > Pending events stack

=item S<    B<'_fam'> > Optional list of operating system families

=item S<    B<'_inv'> > Alternative setting array for auto discovery context

=item S<    B<'_lin'> > Line number

=item S<    B<'_man'> > Module manual text

=item S<    B<'_nam'> > Module name

=item S<    B<'_pag'> > Pager program

=item S<    B<'_req'> > List of required modules

=item S<    B<'_rpt'> > List of settings to include in setting report

=item S<    B<'_sep'> > Separation line

=item S<    B<'_set'> > Setting object list

=item S<    B<'_tmp'> > List of predefined temporary settings

=item S<    B<'_trg'> > List of the modules to trigger

=item S<    B<'_ttl'> > Title for a setting report section

=item S<    B<'_var'> > Setting array

=item S<    B<'_ver'> > Specification version number

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my $slf = shift;
  my $cls = ref($slf) || $slf;
  my ($nam, $dir, $agt) = @_;

  # Create the module definition object
  $slf = bless {_nam => $nam, _dir => $dir}, $cls;

  # Set some attribute defaults
  $slf->{'_col'} = 1;
  $slf->{'_dsc'} = $nam;
  $slf->{'_env'} = [];
  $slf->{'_req'} = [];
  $slf->{'_var'} = [];
  $slf->{'_ver'} = 0;

  # Get some settings
  if (defined($agt))
  { $slf->{'_agt'} = $agt;
    $slf->{'_pag'} =
      exists($ENV{'PAGER'}) ? $ENV{'PAGER'} :
      $agt->is_vms ? 'TYPE/PAGE=SAVE SYS$INPUT' :
      'more';
    $slf->{'_sep'} = ('-' x ($agt->get_setting('RDA_COLUMNS') + 1))."\n";
  }

  # Return the object reference
  $slf;
}

=head2 S<$h-E<gt>display($agt)>

This method displays the setup questions of a module using the pager specified
in the C<PAGER> environment variable. When the pager is not specified, the
method uses C<more> (or C<type/page=save> on VMS) by default.

=cut

sub display
{ my ($slf, $agt) = @_;

  # Display the setup questions
  if (-t STDOUT )
  { open(OUT, '| '.$slf->{'_pag'})
      || die "RDA-00120: Cannot open pager:\n $!\n";
    dsp_module($slf, $agt, *OUT);
    close(OUT);
  }
  else
  { dsp_module($slf, $agt, *STDOUT);
  }
  wait();
}

sub dsp_module
{ my $slf = shift;
  my $agt = shift;
  local *OUT = shift;

  # Display the module section
  _dsp_para($agt, "NAME\n", $slf->{'_nam'}.' - '.$slf->{'_dsc'});
  _dsp_para($agt, "MODULE SETUP\n", $slf->{'_man'}) if exists($slf->{'_man'});

  # Display the setting section
  if (exists($slf->{'_set'}))
  { my ($cnt, $fam, $lvl, @rec);

    $cnt = 0;
    $fam = $agt->get_family;
    $lvl = $agt->get_setting('RDA_LEVEL');
    foreach my $obj (@{$slf->{'_set'}})
    { # Determine if the setting contributes to the report
      next unless $obj->is_valid($fam);
      @rec = $obj->get_detail;
      next unless scalar(@rec) && $lvl >= $rec[1];

      # Provide the setting details
      print OUT "SETTING DESCRIPTION\n" unless $cnt++;
      print OUT $PRE_HDR.$rec[0]."\n";
      _dsp_str($agt, $rec[2]) if defined($rec[2]);
      _dsp_str($agt, $rec[3]) if defined($rec[3]);
    }
  }

  # Display the dependencies
  if (exists($slf->{'_req'}))
  { my @req = map {(m/^[\*\+\-]*(.*)$/)} @{$slf->{'_req'}};
    _dsp_para($agt, "DEPENDENCIES\n", join(', ', @req));
  }

  # Display the copyright and trademark notices
  _dsp_para($agt, "COPYRIGHT NOTICE\n",
    'Copyright (c) 2002-2009, Oracle. All rights reserved.');
  _dsp_para($agt, "TRADEMARK NOTICE\n",
    'Oracle, JD Edwards, PeopleSoft, and Siebel are registered trademarks of '.
    'Oracle Corporation and/or its affiliates. Other names may be trademarks '.
    'of their respective owners.');
}

sub _dsp_para
{ my ($agt, $hdr, $txt) = @_;

  print OUT $hdr;
  $agt->dsp_string(*OUT, $PRE_TXT, $txt, 2);
}

sub _dsp_str
{ my ($agt, $str) = @_;

  $str =~ s/\\n/\n/g;
  $agt->dsp_string(*OUT, $PRE_TXT, $str, 2);
}

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

This method returns the version number of the specifications.

=cut

sub get_version
{ shift->{'_ver'};
}

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

This method indicates whether the module is active. If it is not active, the
module can be skipped during data collection.

=cut

sub is_active
{ shift->{'_col'};
}

=head2 S<$h-E<gt>is_valid($family)>

This method indicates whether the module is applicable for the specified
operating system family.

=cut

sub is_valid
{ my ($slf, $fam) = @_;

  # Accept it directly if there is no restriction
  return 1 unless exists($slf->{'_fam'});

  # Check if the family is included in the list
  for (@{$slf->{'_fam'}})
  { return 1 if $_ eq $fam;
  }

  # Otherwise, reject it
  0;
}

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

This method loads the module definition. It returns 1 if a setup is required.
Otherwise, it returns 0.

=cut

sub load
{ my ($slf) = @_;
  my ($cmd, $lin, $nam, $obj, $pth, $tbl);

  # Initialisation
  $slf->{'_err'} = 0;
  $slf->{'_lin'} = 0;

  # Check if there is a setup associate to the module
  $pth = File::Spec->catfile($slf->{'_dir'}, $slf->{'_nam'}.'.cfg');
  return 0 unless -e $pth;

  # Load the module setup file
  open(IN, "<$pth")
    || die "RDA-00103: Cannot open the setup specification file '$pth':\n $!\n";
  $lin = '';
  $obj = $slf;
  $tbl = \%tb_mod;
  while (<IN>)
  { # Trim leading spaces
    s/^\s+//;
    s/[\r\n]+$//;
    $lin .= $_;

    # Join continuation line
    $slf->{'_lin'}++;
    next if $lin =~ s/\\$//;
    $lin =~ s/\s+$//;

    # Parse the line
    eval {
      if ($lin =~ s/^(\w+)\s*=\s*//)
      { $nam = lc($1);
        die "RDA-00104: Invalid setup attribute keyword '$nam'\n"
          unless exists($tbl->{$nam});
        $cmd = $tbl->{$nam};
        &{$cmd->[1]}($obj, $cmd->[0], \$lin);
        die "RDA-00105: Invalid setup attribute value\n"
          unless $lin =~ m/^\s*(#.*)?$/;
      }
      elsif ($lin =~ s/^\[(\w+)\]$//)
      { $nam = $1;
        $slf->{'_def'}->{$nam} = $obj = RDA::Setting->new($nam);
        $tbl = \%tb_var;
        push(@{$slf->{'_set'}}, $obj);
      }
      elsif ($lin !~ m/^(#.*)?$/)
      { die "RDA-00106: Unexpected setup specification\n";
      }
      elsif (m/\$Id\:\s+\S+\s+(\d+)(\.(\d+))?\s/)
      { $slf->{'_ver'} = sprintf('%d.%02d', $1, $3 || 0);
      }
    };

    # Report an error
    if ($@)
    { my $msg = $@;

      $slf->{'_err'}++;
      $msg =~ s/\n$//;
      $msg .= ' in '.$slf->{'_nam'}.' near line '.$slf->{'_lin'}
        if $slf->{'_lin'};
      print "$msg\n";
    }

    # Prepare the next line
    $lin = '';
  }
  close(IN);

  # Terminate if errors are encountered
  die "RDA-00107: Error(s) in ".$slf->{'_nam'}." setup\n" if $slf->{'_err'};

  # Indicate that a setup can be performed
  1;
}

sub _load_list
{ my ($slf, $key, $buf) = @_;

  $slf->{$key} = [split(/\s*,\s*/, $$buf)];
  $$buf = '';
}

sub _load_name
{ my ($slf, $key, $buf) = @_;

  die "RDA-00108: Invalid name\n"
    unless $$buf =~ s/^((\w|\$\{\w+(:\w+)?\})+|\-(\w|\$\{\w+(:\w+)?\})*)//;
  $slf->{$key} = $1;
}

sub _load_valid
{ my ($slf, $key, $buf) = @_;

  die "RDA-00117: Invalid validation rule\n"
    unless $$buf =~ s/^(E\d*|F|W)//;
  $slf->{$key} = $1;
}

sub _load_text
{ my ($slf, $key, $buf) = @_;
  my $str;

  if ($$buf =~ s/^'([^']*)'// || $$buf =~ s/^"([^"]*)"//)
  { $str = $1;
    $str =~ s/&\#10;/\n/g;
    $str =~ s/&\#34;/"/g;
    $str =~ s/&\#39;/'/g;
    $str =~ s/\\n/\n/g;
    $slf->{$key} = $str;
  }
  else
  { $slf->{$key} = $$buf;
    $$buf = '';
  }
}

sub _load_type
{ my ($slf, $key, $buf) = @_;

  die "RDA-00109: Invalid type\n" unless $$buf =~ s/^([BCDEFILMNPT])//;
  $slf->{$key} = $1;
}

sub _load_val
{ my ($slf, $key, $buf) = @_;
  my $str;

  if ($$buf =~ s/^'([^']*)'// || $$buf =~ s/^"([^"]*)"//)
  { $str = $1;
    $str =~ s/&\#34;/"/g;
    $str =~ s/&\#39;/'/g;
    $slf->{$key} = $str;
  }
  else
  { $slf->{$key} = $$buf;
    $$buf = '';
  }
}

=head2 S<$h-E<gt>log($str)>

This method adds an event to the event stack.

=cut

sub log
{ my ($slf, $str) = @_;

  $slf->{'_evt'} = [] unless exists($slf->{'_evt'});
  push(@{$slf->{'_evt'}}, $str);
}

=head2 S<$h-E<gt>request($agent,$level[,$trace[,$flag]])>

This method requests additional settings. When the flag is set, it performs
setup without user interaction. The module context is unchanged and it
preserves temporary settings. No requisites are considered.

=cut

sub request
{ my ($slf, $agt, $lvl, $trc, $flg) = @_;
  my ($fam, $nam, $pre, $ptr, $var, @tbl);

  # Check if the setup is relevant for the current OS family
  return unless $slf->is_valid($fam = $agt->get_family);

  # Collect the variables
  $nam = $slf->{'_nam'};
  @tbl = @{$slf->{'_var'}};
  while (defined($var = shift(@tbl)))
  { $pre = "REQUEST/$nam/$var:" if $trc;

    # Ignore variables without definitions
    unless (exists($slf->{'_def'}->{$var}))
    { print "$pre definition missing\n" if $trc;
      next;
    }

    # Check if the definition is relevant for the current OS family
    $ptr = $slf->{'_def'}->{$var};
    unless ($ptr->is_valid($fam))
    { print "$pre skipped on this platform\n" if $trc;
      next;
    }

    # Perform the variable setting
    $ptr->setup($slf, $agt, $lvl, \@tbl, $pre, $flg);
  }
}

=head2 S<$h-E<gt>setup($agent,$level[,$trace[,$flag[,$save]]])>

This method collects the setup information for the module. When the flag is
set, it performs the setup without user interaction.

=cut

sub setup
{ my ($slf, $agt, $lvl, $trc, $flg, $sav) = @_;
  my ($fam, $nam, $pre, $ptr, $ret, $str, $var, %bkp, %cur, %prv, @req, @tbl);

  # Check if the setup is relevant for the current OS family
  $nam = $slf->{'_nam'};
  unless ($slf->is_valid($fam = $agt->get_family))
  { $agt->set_collection($nam, 1);
    print "SETUP/$nam: disabled\n" if $trc;
    return ();
  }

  # Clear a previous occurence of the module setup
  %prv = map {$_ => 1} $agt->del_module($nam);

  # Already define the module to prevent loop in pre-requisites
  $agt->set_current($nam, $slf->{'_dsc'});

  # Check the pre-requisites
  foreach my $nam (@{$slf->{'_req'}})
  { if ($nam =~ m/^\*([\+\-]?(.*))$/)
    { push(@req, $1) unless $agt->is_described($2);
    }
    else
    { $agt->setup($nam, $trc, $sav) unless $agt->is_described($nam);
    }
  }
  $agt->set_current($nam);

  # Display the start of the definition
  unless ($flg)
  { print $slf->{'_sep'};
    $agt->dsp_string(*STDOUT, '', join(': ', $nam, $slf->{'_dsc'}), 1);
    print $slf->{'_sep'};
  }

  # Import environment variables as temporary settings
  foreach $var (@{$slf->{'_env'}})
  { next unless exists($ENV{$var});
    unless ($agt->exists_setting($var))
    { $agt->set_temp_setting($var, $ENV{$var});
      print "SETUP/$nam: $var='$ENV{$var}'\n" if $trc;
    }
  }

  # Collect the variables allowing interruptions
  for (;;)
  { # Backup the current status
    $agt->backup_settings;
    %bkp = %prv;

    # Collect the variables
    delete($slf->{'_evt'});
    eval {
      local $SIG{'INT'} = sub { die "Interrupted\n"; };

      @tbl =
        @{$slf->{(exists($slf->{'_inv'}) && $agt->discover) ? '_inv' : '_var'}};
      while (defined($var = shift(@tbl)))
      { $pre = "SETUP/$nam/$var:" if $trc;

        # Ignore variables without definitions
        unless (exists($slf->{'_def'}->{$var}))
        { print "$pre definition missing\n" if $trc;
          next;
        }

        # Check if the definition is relevant for the current OS family
        $ptr = $slf->{'_def'}->{$var};
        unless ($ptr->is_valid($fam))
        { print "$pre skipped on this platform\n" if $trc;
          next;
        }

        # Perform the variable setting
        $var = $ptr->setup($slf, $agt, $lvl, \@tbl, $pre, $flg);
        delete($prv{$var}) if defined($var);
      }
    };

    # Determine the next action
    last unless $@;
    die $@ unless $@ =~ m/^Interrupted/;
    $agt->dsp_string(*STDOUT, '', "\n\nThe setup has been interrupted\n".
      "Do you want to restart it (Y/N)?", 0);
    $str = <STDIN>;
    die "RDA-00121: RDA setup interrupted\n" unless $str =~ m/\s*y(es)?/i;
    $agt->dsp_string(*STDOUT, '', ' ', 1);

    # Restore the initial status
    $agt->restore_settings;
    %prv = %bkp;
  }

  # Check if diagnostic data should be collected
  $slf->{'_col'} = $agt->get_setting($1, $3 || 1)
    if $slf->{'_col'} =~ m/\$\{(\w+)(:([^\}]*))?\}/;
  $agt->set_collection($nam, $slf->{'_col'} ? 0 : 1);
  print "SETUP/$nam: ".($agt->is_disabled($nam) ? 'disabled' : 'enabled')."\n"
    if $trc;

  # Analyze the trigger specification
  if (exists($slf->{'_trg'}))
  { @tbl = ();
    foreach my $trg (@{$slf->{'_trg'}})
    { if ($trg =~ s/^\+//)
      { push(@tbl, $trg)
          unless $agt->is_disabled($nam);
      }
      elsif ($trg =~ s/^\-//)
      { push(@tbl, $trg)
          if $agt->is_disabled($nam);
      }
      elsif ($trg =~ s/^\?(\!)?(\w+)\://)
      { push(@tbl, $trg)
          if defined($1) xor $agt->get_setting($2, 0);
      }
      else
      { push(@tbl, $trg);
      }
    }
    if (@tbl)
    { $slf->{'-trg'} = join(',', @tbl);
    }
    else
    { delete($slf->{'-trg'});
    }
  }

  # Define settings for the setting report
  foreach my $key (sort keys(%tb_def))
  { $ptr = $tb_def{$key};
    if (exists($slf->{$key}))
    { $var = $nam.$ptr->[0];
      $agt->set_setting($var, $slf->{$key}, $ptr->[1], $ptr->[2]);
      delete($prv{$var});
    }
  }

  # Delete obsolete variables
  foreach $var (keys %prv)
  { $agt->del_setting($var);
  }

  # Store the pending events
  if ($ptr = delete($slf->{'_evt'}))
  { $agt->log_force;
    foreach my $evt (@$ptr)
    { my ($typ, @det) = split(/\|/, $evt);
      $agt->log($typ, @det) if $typ && $typ =~ m/^\w{2,}$/;
    }
  }

  # Return the list of post-requisites
  @req;
}

=head2 S<$h-E<gt>xref($agent)>

This method produces a cross-reference of the setting definitions and their
references.

=cut

sub xref
{ my ($slf, $agt) = @_;

  if (-t STDOUT )
  { my $pag =
      exists($ENV{'PAGER'}) ? $ENV{'PAGER'} :
      $agt->is_vms ? 'TYPE/PAGE=SAVE SYS$INPUT' :
      'more';
    open(OUT, "| $pag")
      || die "RDA-00120: Cannot open pager:\n $!\n";
    _xref($slf, $agt, *OUT);
    close(OUT);
  }
  else
  { _xref($slf, $agt, *STDOUT);
  }
  wait();
}

sub _xref
{ my ($slf, $agt, $out) = @_;
  my ($err, $obj, $typ, @tb_mis, @tb_not, @tb_use, %tb_def);

  # Load the module
  eval {$slf->load;};
  $err = $@;

  # Analyze the module
  _xref_def($slf, $slf, "<MODULE>", 'var', 'inv');
  _xref_ref($slf, $slf, '_var', "<MODULE>(var)");
  _xref_ref($slf, $slf, '_inv', "<MODULE>(inv)");
  foreach my $nam (sort keys(%{$slf->{'_def'}}))
  { $obj = $slf->{'_def'}->{$nam};
    $typ = $obj->{'_typ'};
    _xref_def($slf, $obj, "$nam($typ)", 'var', 'alt');
    _xref_ref($slf, $obj, '_var', "$nam(var)");
    _xref_ref($slf, $obj, '_alt', "$nam(alt)");
    if ($typ eq 'I' && $obj->{'_dft'} =~ m/^decode:/i)
    { my ($key, $lst, @nxt, @tbl);

      @tbl = split(/:/, $obj->{'_dft'});
      while (($key, $lst) = splice(@tbl, 0, 2))
      { next unless defined $lst;
        if ($key eq 'decode')
        { push(@{$slf->{'-use'}->{$lst}}, "$nam(dec)");
        }
        else
        { @nxt = split(/,/, $lst);
          foreach my $arg (@nxt)
          { push(@{$slf->{'-use'}->{$arg}}, "$nam(dec/$key)");
          }
          $slf->{'-def'}->{"$nam(I)"}->{"dec/$key: "} = [@nxt];
        }
      }
    }
  }

  # Classify the setting definitions
  foreach my $nam (sort keys(%{$slf->{'-def'}}))
  { if ($nam eq '<MODULE>' || exists($slf->{'-use'}->{substr($nam, 0, -3)}))
    { push(@tb_use, $nam);
    }
    else
    { push(@tb_not, $nam);
    }
    $tb_def{substr($nam, 0, -3)} = 1 unless $nam eq '<MODULE>';
  }
  foreach my $nam (sort keys(%{$slf->{'-use'}}))
  { push(@tb_mis, $nam) unless exists($tb_def{$nam});
  }

  # Display the cross-reference
  $agt->dsp_string($out, '', "Module ".$slf->{'_nam'}.".cfg Cross Reference\n");
  $agt->dsp_string($out, '', "  $err error(s) detected at load\n") if $err;
  _xref_dsp($slf, $agt, $out, \@tb_use, '-def', 'Definitions Used');
  _xref_dsp($slf, $agt, $out, \@tb_not, '-def', 'Definitions Unused');
  _xref_dsp($slf, $agt, $out, \@tb_mis, '-use', 'Missing Definitions');
  _xref_dsp($slf, $agt, $out, $slf->{'-use'}, '-use', 'References');
}

# Analyse a definition
sub _xref_def
{ my $slf = shift;
  my $obj = shift;
  my $nam = shift;

  $slf->{'-def'}->{$nam} = {};
  foreach my $arg (@_)
  { my $key = "_$arg";
    $slf->{'-def'}->{$nam}->{"$arg: "} = $obj->{$key}
      if ref($obj->{$key}) && scalar(@{$obj->{$key}});
  }
}

# Display a result set
sub _xref_dsp
{ my ($slf, $agt, $out, $tbl, $key, $ttl) = @_;
  my ($cur, $max);

  return unless ($cur = ref($tbl));
  $tbl = [sort keys(%$tbl)] if $cur eq 'HASH';

  if (scalar(@$tbl))
  { # Determine the name length
    $max = 0;
    foreach my $nam (@$tbl)
    { $max = $cur if ($cur = length($nam)) > $max;
    }

    # Display the table
    $agt->dsp_string($out, '', "\n$ttl:\n");
    foreach my $nam (@$tbl)
    { if (ref($slf->{$key}->{$nam}) eq 'HASH')
      { my $str = join("\n", map {$_.join(', ',@{$slf->{$key}->{$nam}->{$_}})}
          keys(%{$slf->{$key}->{$nam}})); 
        if ($str)
        { $agt->dsp_string($out, sprintf("  %-*s  ", $max, $nam), $str);
        }
        else
        { $agt->dsp_string($out, '  ', $nam);
        }
      }
      else
      { $agt->dsp_string($out, sprintf("  %-*s  ", $max, $nam),
          join(', ', @{$slf->{$key}->{$nam}}));
      }
    }
  }
}

# Determine the references
sub _xref_ref
{ my ($slf, $obj, $key, $nam) = @_;

  if (ref($obj->{$key}))
  { foreach my $arg (@{$obj->{$key}})
    { push(@{$slf->{'-use'}->{$arg}}, $nam);
    }
  }
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>, L<RDA::Block|RDA::Block>,
L<RDA::Daemon|RDA::Daemon>, L<RDA::Discover|RDA::Discover>,
L<RDA::Extra|RDA::Extra>, L<RDA::Filter|RDA::Filter>,
L<RDA::Lock|RDA::Lock>, L<RDA::Log|RDA::Log>,
L<RDA::Output|RDA::Output>, L<RDA::Pod|RDA::Pod>,
L<RDA::Profile|RDA::Profile>, L<RDA::Remote|RDA::Remote>,
L<RDA::Render|RDA::Render>, L<RDA::Setting|RDA::Setting>,
L<RDA::Upgrade|RDA::Upgrade>, L<RDA::Value|RDA::Value>,
L<RDA::Web|RDA::Web>

=head1 COPYRIGHT NOTICE

Copyright (c) 2002-2009, Oracle. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle, JD Edwards, PeopleSoft, and Siebel are registered trademarks of Oracle
Corporation and/or its affiliates. Other names may be trademarks of their
respective owners.

=cut