# Xml.pm: Class Used for XML Macros

package RDA::Library::Xml;

# $Id: Xml.pm,v 1.13 2015/07/23 23:35:35 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Library/Xml.pm,v 1.13 2015/07/23 23:35:35 RDA Exp $
#
# Change History
# 20150718  MSC  Suppress unused attribute.

=head1 NAME

RDA::Library::Xml - Class Used for XML Macros

=head1 SYNOPSIS

 require RDA::Library::Xml;

=head1 DESCRIPTION

The objects of the C<RDA::Library::Xml> class are used to interface with XML
macros.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use RDA::Text qw(get_string);
  use RDA::Alarm qw(check_alarm clear_alarm set_alarm);
  use RDA::Driver::Library qw(exe_command get_alarm log_timeout);
  use RDA::Object;
  use RDA::Object::Rda;
  use RDA::Object::Xml;
  use RDA::Value::List;
  use RDA::Value::Scalar qw(:value);
}

# Define the global public variables
use vars qw($STRINGS $SUSPEND $VERSION @ISA);
$SUSPEND = {
  err => 0,
  trc => sub {return $_[0]->{'_col'}->get_trace('XML')},
  };

$VERSION = sprintf('%d.%02d', q$Revision: 1.13 $ =~ /(\d+)\.(\d+)/);
@ISA     = qw(RDA::Driver::Library Exporter);

# Define the global private constants
my $XML = 'RDA::Object::Xml';

# Define the global private variables
my %tb_fct = (
  'setXmlTrace'    => [\&_m_trace,       'N'],
  'xmlAttributes'  => [\&_m_attrs,       'L'],
  'xmlContent'     => [\&_m_content,     'L'],
  'xmlData'        => [\&_m_data,        'T'],
  'xmlDisable'     => [\&_m_disable,     'O'],
  'xmlError'       => [\&_m_error,       'N'],
  'xmlExists'      => [\&_m_exists,      'N'],
  'xmlFind'        => [\&_m_find,        'L'],
  'xmlLoadCommand' => [\&_m_load_cmd,    'O'],
  'xmlLoadFile'    => [\&_m_load_file,   'O'],
  'xmlName'        => [\&_m_name,        'T'],
  'xmlNormalize'   => [\&_m_normalize,   'O'],
  'xmlParser'      => [\&_m_parser,      'O'],
  'xmlStatCommand' => [\&_m_stat_cmd,    'N'],
  'xmlType'        => [\&_m_type,        'T'],
  'xmlValue'       => [\&_m_value,       'T'],
  );

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

=head2 S<$h = RDA::Library::Xml-E<gt>new($driver,$collector)>

The object constructor. It takes the library driver and collector references as
arguments.

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

=over 12

=item S<    B<'err' > > Last command exit code

=item S<    B<'lim' > > Execution time limit (in sec)

=item S<    B<'trc' > > XML trace flag

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

=item S<    B<'_not'> > Statistics note

=item S<    B<'_out'> > Number of XML requests timed out

=item S<    B<'_req'> > Number of XML requests

=item S<    B<'_vms'> > VMS indicator

=item S<    B<'_win'> > Windows indicator

=item S<    B<'_wrk'> > Reference to the work file manager

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my ($cls, $drv, $col) = @_;
  my ($slf);

  # Create the macro object
  $slf = bless {
    err  => 0,
    _out => 0,
    _req => 0,
    _sap => RDA::Object::Rda->is_windows || RDA::Object::Rda->is_cygwin,
    _sys => $col->get_agent->get_system,
    _vms => RDA::Object::Rda->is_vms,
    _win => RDA::Object::Rda->is_windows,
    }, ref($cls) || $cls;

  # Register the macros
  $drv->register($slf, [keys(%tb_fct)], qw(refresh suspend usage));

  # Return the object reference
  return refresh($slf, $col);
}

=head2 S<$h-E<gt>call($name,...)>

This method executes the macro code.

=cut

sub call
{ my ($slf, $nam, @arg) = @_;

  return &{$tb_fct{$nam}->[0]}($slf, @arg);
}

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

This method resets the statistics and clears corresponding module settings.

=cut

sub clr_stats
{ my ($slf) = @_;

  $slf->{'_not'} = q{};
  $slf->{'_req'} = $slf->{'_out'} = 0;
  return;
}

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

This method deletes the library control object.

=cut

sub delete_object
{ RDA::Object::dump_caller($_[0], 'Library') if $RDA::Object::DELETE;
  undef %{$_[0]};
  undef $_[0];
  return;
}

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

This method reports the library statistics in the specified module.

=cut

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

  if ($slf->{'_req'})
  { # Get the statistics record
    $use = $slf->{'_col'}->get_usage;
    $use->{'XML'} = {not => q{}, out => 0, req => 0}
      unless exists($use->{'XML'});
    $use = $use->{'XML'};

    # Indicate the current timeout when there is no other note
    $slf->{'_not'} = 'Command execution limited to '.$slf->{'lim'}.'s'
      unless $use->{'not'} || $slf->{'_not'} ||  ## no critic (Unless)
             $slf->{'lim'} <= 0;

    # Generate the module statistics
    $use->{'out'} += $slf->{'_out'};
    $use->{'req'} += $slf->{'_req'};
    $use->{'not'} = $slf->{'_not'} if $slf->{'_not'};

    # Clear statistics
    clr_stats($slf);
  }
  return;
}

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

This method updates the library control object for a new collector.

=cut

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

  $dft = $col->get_info('dft');
  $trc = $col->get_trace('TIME');
  $slf->{'lim'}  = $trc ? 0 : check_alarm($dft->get_first('N_TIMEOUT', 30));
  $slf->{'trc'}  = $col->get_trace('XML');
  $slf->{'_col'} = $col;

  # Determine the request method
  delete($slf->{'_wrk'});
  $slf->{'_wrk'} = $col
    if $slf->{'_win'} || $slf->{'_vms'} || $dft->get_first('B_USE_TEMP');

  return $slf;
}

=head2 S<$h-E<gt>run($name,$arg,$ctx)>

This method executes the macro with the specified argument list in a given
context.

=cut

sub run
{ my ($slf, $nam, $arg, $ctx) = @_;
  my ($fct, $ret, $typ);

  $fct = $tb_fct{$nam};
  $typ = $fct->[1];

  # Treat an array context
  return RDA::Value::List::new_from_data(&{$fct->[0]}($slf, $ctx,
    $arg->eval_as_array)) if $typ eq 'L';

  # Treat a scalar context
  return defined($ret = &{$fct->[0]}($slf, $ctx, $arg->eval_as_array))
    ? RDA::Value::Scalar->new($typ, $ret)
    : $VAL_UNDEF;
}

=head1 XML MACROS

=head2 S<xmlAttributes($xml)>

This macro returns the list of node attributes.

=cut

sub _m_attrs
{ my ($slf, $ctx, $xml) = @_;
  my @tbl;

  if (ref($xml) eq $XML)
  { @tbl = grep {m/^[^-]/} keys(%{$xml});
  }
  return (sort @tbl);
}

=head2 S<xmlContent($xml[,$flt])>

This macro returns the list of child nodes after resolving the conditions. The
second argument specifies the list of child types to consider. By default, it
returns all child nodes.

=cut

sub _m_content
{ my ($slf, $ctx, $xml, $flt) = @_;
  my @tbl;

  return () unless ref($xml) eq $XML;
  return $xml->get_content($flt);
}

=head2 S<xmlData($xml)>

This macro extracts the texts and CDATA elements contained in the specified
node. It returns an empty string when it cannot find any data.

=cut

sub _m_data
{ my ($slf, $ctx, $xml) = @_;

  return (ref($xml) eq $XML) ? $xml->get_data : q{};
}

=head2 S<xmlError($xml)>

This macro returns the number of parsing errors.

=cut

sub _m_error
{ my ($slf, $ctx, $xml) = @_;

  return (ref($xml) eq $XML) ? $xml->get_error : 0;
}

=head2 S<xmlExists($xml,$attr)>

This macro indicates whether the attribute exists in the specified node.

=cut

sub _m_exists
{ my ($slf, $ctx, $xml, $key, $dft) = @_;

  return ref($xml) eq $XML && $xml->exists($key);
}

=head2 S<xmlFind($xml,$qry)>

This macro performs the query on the XML object. It returns the result as an
object list.

=cut

sub _m_find
{ my ($slf, $ctx, $xml, $qry) = @_;
  my (@tbl);

  return () unless ref($xml) eq $XML;
  return $xml->find($qry);
}

=head2 S<xmlLoadCommand($cmd[,$inc[,$xml]])>

This macro parses the XML produced by the specified command. It stores the
effective command exit code and is accessible through the C<xmlStatCommand>
macro. It returns the resulting XML object.

You can increase the execution limit by specifying an increasing factor as an
argument. A negative value disables any timeout.

You can specify a parser as an argument to control what information is
extracted.

=cut

sub _m_load_cmd
{ my ($slf, $ctx, $cmd, $inc, $xml) = @_;

  return exe_command(\&_load_in,
    (ref($xml) eq $XML) ? $xml : RDA::Object::Xml->new($slf->{'trc'}),
    $slf, $ctx, $cmd, 'XML', $inc);
}

sub _load_in
{ my ($xml, $slf, $ctx, $ifh, $fil, $cmd, $lim, $pid) = @_;
  my ($sta);

  eval {
    local $SIG{'ALRM'} = sub { die "Alarm\n"; } if $lim;

    # Scan the input
    set_alarm($lim) if $lim;
    while (<$ifh>)
    { $xml->parse($_);
    }
    $xml->eof;
    clear_alarm() if $lim;
  };
  RDA::Object::Rda->kill_child($pid) if ($sta = $@) && $pid;
  close($ifh);
  if ($sta)
  { log_timeout($slf, $ctx, 'XML', $cmd);
  }
  elsif ($cmd)
  { $slf->{'err'} = $?;
  }
  return;
}

=head2 S<xmlLoadFile($fil[,$xml])>

This macro parses an XML file and returns the resulting XML object. You can
specify a parser as an argument to control what information is extracted.

=cut

sub _m_load_file
{ my ($slf, $ctx, $fil, $xml) = @_;

  $xml = RDA::Object::Xml->new($slf->{'trc'}) unless ref($xml) eq $XML;
  return $xml->parse_file($fil);
}

=head2 S<xmlName($xml)>

This macro returns the node name when defined. Otherwise, it returns an
undefined value.

=cut

sub _m_name
{ my ($slf, $ctx, $xml) = @_;

  return (ref($xml) eq $XML) ? $xml->get_name : undef;
}

=head2 S<xmlStatCommand()>

This macro returns the exit code of the last XML command.

=cut

sub _m_stat_cmd
{ return shift->{'err'};
}

=head2 S<xmlType($xml)>

This macro returns the node type.

=cut

sub _m_type
{ my ($slf, $ctx, $xml) = @_;

  return (ref($xml) eq $XML) ? $xml->get_type : undef;
}

=head2 S<xmlValue($xml,$attr[,$dft])>

This macro returns the value of the attribute in the specified node. When not
defined, it returns the default value.

=cut

sub _m_value
{ my ($slf, $ctx, $xml, $key, $dft) = @_;

  return (ref($xml) eq $XML) ? $xml->get_value($key, $dft) : $dft;
}

=head1 PARSER MACROS

=head2 S<setXmlTrace([$lvl])>

This macro sets the XML parsing level:

=over 7

=item B<    0 > No trace

=item B<    1 > Trace the XML parsing

=back

The level is unchanged if a new level is not defined.

It returns the previous level.

=cut

sub _m_trace
{ my ($slf, $ctx, $lvl) = @_;
  my $old;

  $old = $slf->{'trc'};
  $slf->{'trc'} = $lvl if defined($lvl);
  return $old;
}

=head2 S<xmlDisable($xml[,$flt])>

This macro indicates the list of child types to ignore. When the list is
empty, it disables any type filtering. It returns the parser object reference.

=cut

sub _m_disable
{ my ($slf, $ctx, $xml, $flt) = @_;

  return (ref($xml) eq $XML) ? $xml->disable($flt) : undef;
}

=head2 S<xmlNormalize($xml,$typ)>

This macro indicates how RDA must normalize the texts. It returns the parser
object reference.

=cut

sub _m_normalize
{ my ($slf, $ctx, $xml, $typ) = @_;

  return unless ref($xml) eq $XML;
  $xml->normalize_text($typ);
  return $xml;
}

=head2 S<xmlParser()>

This macro initializes a new XML parser and returns its reference.

=cut

sub _m_parser
{ my ($slf, $ctx) = @_;

  return RDA::Object::Xml->new($slf->{'trc'});
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Alarm|RDA::Alarm>,
L<RDA::Driver::Library|RDA::Driver::Library>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Buffer|RDA::Object::Buffer>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Object::Xml|RDA::Object::Xml>,
L<RDA::SDCL::Block|RDA::SDCL::Block>,
L<RDA::Text|RDA::Text>,
L<RDA::Value::List|RDA::Value::List>,
L<RDA::Value::Scalar|RDA::Value::Scalar>

=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