# Language.pm: Class Used for Controlling SDSL Code Execution

package RDA::SDSL::Language;

# $Id: Language.pm,v 1.11 2015/11/16 18:46:41 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/SDSL/Language.pm,v 1.11 2015/11/16 18:46:41 RDA Exp $
#
# Change History
# 20151116  MSC  Add the define_data method.

=head1 NAME

RDA::SDSL::Language - Class Used for Controlling SDSL Code Execution

=head1 SYNOPSIS

 require RDA::SDSL::Language;

=head1 DESCRIPTION

The objects of the C<RDA::SDSL::Language> class are used to execute Support
Diagnostic Setup Language (SDSL) code. It is a subclass of
L<RDA::Object|RDA::Object>.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::File;
  use RDA::Text qw(get_string);
  use RDA::Handle::Vector;
  use RDA::Object;
  use RDA::Object::Content qw($RE_DC);
  use RDA::Object::Rda;
  use RDA::SDSL::Module;
}

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

# Define the global private constants

# Define the global private variables

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

=head2 S<$h = RDA::SDSL::Language-E<gt>new($agent)>

The object constructor for language object. This method takes the agent
reference as an extra argument.

The following special keys are used:

=over 12

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

=item S<    B<'cfg' > > Reference to the RDA software configuration

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

=item S<    B<'dat' > > Predefined packages

=item S<    B<'dir' > > Collect directory structure

=item S<    B<'lvl' > > Trace level

=item S<    B<'oid' > > Context name

=item S<    B<'use' > > Module usage hash

=back

=cut

sub new
{ my ($cls, $agt) = @_;
  my ($cfg, $slf);

  # Create the language object and return its reference
  $cfg = $agt->get_config;
  $slf = bless {
    agt  => $agt,
    cfg  => $cfg,
    col  => $agt->get_collector,
    dat  => {},
    dir  => $cfg->get_group('D_RDA_COL'),
    lvl  => $agt->get_level,
    oid  => $agt->get_oid,
    use  => {},
    }, ref($cls) || $cls;
  $agt->trace(get_string('SdslInit'))
    unless $slf->{'lvl'} < 10;  ## no critic (Unless)

  # Return the object reference
  return $slf;
}

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

This method returns the value of an agent object attribute or the default
value when the attribute is not defined.

It returns the agent object reference when no attribute name is specified.

=cut

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

  return defined($nam) ? $slf->{'agt'}->get_info($nam, $dft) : $slf->{'agt'};
}

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

This method returns the value of an collector object attribute or the default
value when the attribute is not defined.

It returns the collector object reference when no attribute name is specified.

=cut

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

  return defined($nam) ? $slf->{'col'}->get_info($nam, $dft) : $slf->{'col'};
}

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

This method returns a reference to the RDA software configuration.

=cut

sub get_config
{ return shift->{'cfg'};
}

=head2 S<$h-E<gt>refresh($collector)>

This method updates the language interface for a new collector. It returns a
reference to the language interface object.

=cut

sub refresh
{ my ($slf, $col) = @_;

  # Update the collector information
  $slf->{'col'} = $col if ref($col) eq 'RDA::Object::Collect';

  # Return the object reference
  return $slf;
}

=head1 SETUP MODULE MANAGEMENT METHODS

=head2 S<$h-E<gt>define_data($name,$data)>

This method defines a new package and loads its definition. It returns its
reference.

=cut

sub define_data
{ my ($slf, $nam, $dat) = @_;

  return $slf->{'dat'}->{"DATA:$nam"} = $dat;
}

=head2 S<$h-E<gt>load_data($ifh,$group,$name)>

This method creates new package and loads its definition. It returns its
reference.

=cut

sub load_data
{ my ($slf, $ifh, $grp, $nam, $flg) = @_;

  return RDA::SDSL::Module->new($slf, $grp, $nam)->parse($ifh, $flg);
}

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

This method creates new package, loads its definition, and returns its
reference. It returns an undefined value when it cannot open the file.

=cut

sub load_file
{ my ($slf, $nam, $dir, $flg) = @_;
  my ($ifh, $obj);

  $dir = $slf->{'dir'} unless defined($dir);
  $slf->{'agt'}->abort(get_string('NO_PATH')) unless defined($nam);
  $nam =~ s/\.(ctl|cfg|exe)$//i;
  $ifh = IO::File->new;
  if ($ifh->open('<'.RDA::Object::Rda->cat_file($dir, "$nam.cfg")))
  { $obj = $slf->load_data($ifh, undef, $nam, $flg);
    $obj->set_info('dir', $dir);
  }
  return $obj;
}

=head2 S<$h-E<gt>load_package($module)>

This method creates new package, loads its definition from the SDSL directory
group, and returns its reference. It returns an undefined value when it cannot
open the file.

=cut

sub load_package
{ my ($slf, $mod, $flg) = @_;
  my ($ifh, $pth);

  $slf->{'agt'}->abort(get_string('NO_MODULE'))
    unless $mod =~ m/^(\w+):((DC)?(\w+))$/i;
  if (exists($slf->{'dat'}->{$mod}))
  { $ifh = RDA::Handle::Vector->new($slf->{'dat'}->{$mod});
    return RDA::SDSL::Module->new($slf, $1, $2)->parse($ifh)
  }
  $pth = RDA::Object::Rda->cat_file($slf->{'dir'}, $1, "$2.cfg");
  $ifh = IO::File->new;
  return
    $ifh->open("<$pth")
      ? $slf->load_data($ifh, $1, $2, $flg) :
    ($3 && -f ($pth = RDA::Object::Rda->cat_file($slf->{'dir'}, $1, "$2.ctl")))
      ? [$1, $pth, uc($4)] :
    undef;
}

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

This method returns a normalized module name, which includes the module group
and the package identifier.

=cut

sub norm_package
{ my ($slf, $grp, $nam, $dft) = @_;
  my ($dir, $pth, @grp);

  if ($nam =~ m/^(\w+):(\w+)$/)
  { @grp = ($1);
    $nam = $2;
  }
  elsif (ref($grp) eq 'ARRAY')
  { @grp = @{$grp};
  }
  else
  { @grp = ($grp);
  }

  $dir = $slf->{'dir'};
  foreach my $sub (@grp)
  { $pth = RDA::Object::Rda->cat_file($dir, $sub, $nam);
    return join(q{:}, $sub, $nam) if -f "$pth.cfg" || -f "$pth.ctl";
  }
  return $dft unless wantarray;
  return @{$dft} if ref($dft) eq 'ARRAY';
  return ($dft)  if defined($dft);
  return ();
}

=head2 S<$h-E<gt>search_package($group,$name)>

This method creates new package and loads its definition. When the specified
name is in the module format, it attempts to run C<load_package>. Otherwise,
the file containing its code is searched in the specified groups. It returns a
package reference on successful search or an undefined value otherwise.

=cut

sub search_package
{ my ($slf, $grp, $nam, $flg, $col) = @_;
  my ($abr, $bas, $dir, $ifh, $pth, @grp);

  # Determine the applicable groups
  $slf->{'agt'}->abort(get_string('NO_NAME')) unless defined($nam);
  return $slf->load_package($nam, $flg) if $nam =~ m/^(\w+):(\w+)$/;
  $grp = [$grp] unless ref($grp) eq 'ARRAY';

  # Check the module abbreviation
  $bas = RDA::Object::Rda->basename($nam);
  if ($bas =~ $RE_DC)
  { $abr = $3;
  }
  elsif ($col)
  { return;
  }

  # Search in the specified groups
  $dir = $slf->{'dir'};
  $ifh = IO::File->new;
  foreach my $sub (@{$grp})
  { # Search for a SDSL package
    $pth = RDA::Object::Rda->cat_file($dir, $sub, "$bas.cfg");
    if (-f $pth)
    { $ifh->open("<$pth")
        or $slf->{'agt'}->abort($!, get_string('ERR_OPEN', $pth));
      return $slf->load_data($ifh, $sub, $bas, $flg);
    }

    # Search for a SDCL package
    $pth =~ s/cfg$/ctl/;
    return [$sub, $pth, $abr] if -f $pth;
  }
  return;
}

=head1 USAGE MANAGEMENT METHODS

=head2 S<$h-E<gt>add_usage($obj)>

This method adds module information.

=cut

sub add_usage
{ my ($slf, $obj) = @_;

  return $slf->{'use'}->{$obj->get_oid} = $obj->get_version;
}

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

This method returns the module usage hash.

=cut

sub get_usage
{ return shift->{'_use'};
}

=head2 S<$h-E<gt>set_usage($use)>

This method sets a new usage hash and returns the previous one.

=cut

sub set_usage
{ my ($slf, $use) = @_;

  ($use, $slf->{'use'}) = ($slf->{'use'}, $use);
  return $use;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Handle::Vector|RDA::Handle::Vector>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Collect|RDA::Object::Collect>,
L<RDA::Object::Content|RDA::Object::Content>,
L<RDA::Object::Env|RDA::Object::Env>,
L<RDA::Object::Item|RDA::Object::Item>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::SDSL::Module|RDA::SDSL::Module>,
L<RDA::SDSL::Setting|RDA::SDSL::Setting>
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