# Remote.pm: Class Used for Remote Operation Macros

package RDA::Library::Remote;

# $Id: Remote.pm,v 1.25 2015/05/08 18:11:48 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Library/Remote.pm,v 1.25 2015/05/08 18:11:48 RDA Exp $
#
# Change History
# 20150508  MSC  Improve the documentation.

=head1 NAME

RDA::Library::Remote - Class Used for Remote Operation Macros

=head1 SYNOPSIS

 require RDA::Library::Remote;

=head1 DESCRIPTION

The objects of the C<RDA::Library::Remote> class are used to interface with
remote operation macros.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use File::Copy qw(copy move);
  use IO::File;
  use RDA::Text qw(get_string);
  use RDA::Alarm qw(check_alarm clear_alarm set_alarm);
  use RDA::Driver::Library;
  use RDA::Local::Unix;
  use RDA::Object;
  use RDA::Object::Item;
  use RDA::Object::Message;
  use RDA::Object::Rda qw($APPEND $CREATE $FIL_PERMS);
  use RDA::Object::Remote;
  use RDA::SDCL::Value qw($VALUE);
  use RDA::Value::List;
  use RDA::Value::Scalar qw(:value);
}

# Define the global public variables
use vars qw($STRINGS $SUSPEND $VERSION @ISA);
$SUSPEND = {
   _ses => undef,
   };
$VERSION = sprintf('%d.%02d', q$Revision: 1.25 $ =~ /(\d+)\.(\d+)/);
@ISA     = qw(RDA::Driver::Library Exporter);

# Define the global private constants
my $ALR = '___Alarm___';

# Define the global private variables
my %tb_fct = (
  'get'              => [\&_m_get,           'N'],
  'getRemoteLines'   => [\&_m_get_lines,     'L'],
  'getRemoteMessage' => [\&_m_get_message,   'T'],
  'hasRemoteTimeout' => [\&_m_has_timeout,   'N'],
  'initRemote'       => [\&_m_init_remote,   'N'],
  'mget'             => [\&_m_mget,          'N'],
  'mput'             => [\&_m_mput,          'N'],
  'needPassword'     => [\&_m_need_password, 'N'],
  'needPause'        => [\&_m_need_pause,    'N'],
  'put'              => [\&_m_put,           'N'],
  'rcollect'         => [\&_m_rcollect,      'N'],
  'rda'              => [\&_m_rda,           'N'],
  'rexec'            => [\&_m_rexec,         'N'],
  'transfer'         => [\&_m_transfer,      'N'],
  );

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

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

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

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

=over 12

=item S<    B<'trc' > > Remote execution trace flag

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

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

=item S<    B<'_err'> > Last command error lines

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

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

=item S<    B<'_req'> > Number of operating system requests

=item S<    B<'_ses'> > Reference the last session

=item S<    B<'_ssh'> > Authentication agent indicator

=back

Internal keys are prefixed by an underscore.

=cut

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

  # Create the macro object
  $slf = bless {
    _cfg => $col->get_config,
    _err => [],
    _out => 0,
    _req => 0,
    _ssh => 0,
    _ses => undef,
    }, 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->{'_ses'} = undef;
  $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 ($lim, $use);

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

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

    # Reset the 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) = @_;

  $slf->{'trc'}  = $col->get_trace('REMOTE');
  $slf->{'_col'} = $col;
  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 REMOTE MACROS

=head2 S<get($node,$rdir,$rname[,$ldir[,$lname]])>

This macro gets a single file from a remote node. By default, the same directory
and file name are assumed for the local destination. However, it takes remote
relative paths from the home directory, and local paths from the working
directory.

It returns the command exit code when the request is executed. Otherwise, it
returns -1.

=cut

sub _m_get
{ my ($slf, $ctx, $nod, @arg) = @_;

  return -1 unless $nod;

  # Execute the remote request
  $slf->{'_ses'} = $ctx->get_remote->get_session($nod, 1);
  return $slf->{'_ses'}->get(@arg);
}

=head2 S<getRemoteLines([$node])>

This macro returns the lines stored during the last command execution.

=cut

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

  $slf->{'_ses'} = $ctx->get_remote->get_session($nod, 1) if defined($nod);
  return () unless $slf->{'_ses'};
  return $slf->{'_ses'}->get_lines;
}

=head2 S<getRemoteMessage([$node])>

This macro returns the last message.

=cut

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

  $slf->{'_ses'} = $ctx->get_remote->get_session($nod, 1) if defined($nod);
  return $slf->{'_ses'}
    ? $slf->{'_ses'}->get_message
    : undef;
}

=head2 S<hasRemoteTimeout([$node])>

This macro indicates whether the last request encountered a timeout.

=cut

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

  $slf->{'_ses'} = $ctx->get_remote->get_session($nod, 1) if defined($nod);
  return $slf->{'_ses'}
    ? $slf->{'_ses'}->has_timeout
    : undef;
}

=head2 S<initRemote()>

This macro forces the initialization of the authentication agent. It returns
the authentication agent status.

=cut

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

  $slf->{'_ssh'} = $slf->{'_col'}->get_remote->set_agent unless $slf->{'_ssh'};
  return $slf->{'_ssh'};
}

=head2 S<mget($node,$flg,$rdir[,$re[,$ldir]])>

This macro gets one or more files from a remote node. The name may contain
shell meta characters. By default, the same directory name is assumed for the
local destination. However, it takes remote relative paths from the home
directory and local paths from the working directory. If the flag is set, it
copies entire directories recursively.

It returns the command exit code when the request is executed. Otherwise, it
returns -1.

=cut

sub _m_mget
{ my ($slf, $ctx, $nod, @arg) = @_;

  return -1 unless $nod;

  # Execute the remote request
  $slf->{'_ses'} = $ctx->get_remote->get_session($nod, 1);
  return $slf->{'_ses'}->mget(@arg);
}

=head2 S<mput($node,$ldir[,$re[,$rdir]])>

This macro puts one or more files into a remote node. You can use a regular
expression to select the files inside the local directory. By default, it
assumes the same directory name for the remote destination. However, it takes
remote relative paths from the home directory, and local paths from the working
directory. If the flag is set, it copies entire directories recursively.

It returns the command exit code when the request is executed. Otherwise, it
returns -1.

=cut

sub _m_mput
{ my ($slf, $ctx, $nod, @arg) = @_;

  return -1 unless $nod;

  # Execute the remote request
  $slf->{'_ses'} = $ctx->get_remote->get_session($nod, 1);
  return $slf->{'_ses'}->mput(@arg);
}

=head2 S<needPassword([$node])>

This macro indicates whether the remote session requires a password.

=cut

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

  $slf->{'_ses'} = $ctx->get_remote->get_session($nod, 1) if defined($nod);
  return $slf->{'_ses'}
    ? $slf->{'_ses'}->need_password
    : undef;
}

=head2 S<needPause([$node])>

This macro indicates whether the remote session could require a pause for
providing a password.

=cut

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

  $slf->{'_ses'} = $ctx->get_remote->get_session($nod, 1) if defined($nod);
  return $slf->{'_ses'}
    ? $slf->{'_ses'}->need_pause
    : undef;
}

=head2 S<put($node,$ldir,$lname[,$rdir[,$rname]])>

This macro puts a single file into a remote node. By default, it assumes the
same directory and file name for the remote destination. However, it takes
remote relative paths from the home directory, and local paths from the working
directory.

It returns the command exit code when the request is executed. Otherwise, it
returns -1.

=cut

sub _m_put
{ my ($slf, $ctx, $nod, @arg) = @_;

  return -1 unless $nod;

  # Execute the remote request
  $slf->{'_ses'} = $ctx->get_remote->get_session($nod, 1);
  return $slf->{'_ses'}->put(@arg);
}

=head2 S<rcollect($node,$job,$fil[,$var])>

This macro saves the output of the shell execution on the remote node in the
specified file.

It returns the command exit code when the request is executed. Otherwise, it
returns -1.

=cut

sub _m_rcollect
{ my ($slf, $ctx, $nod, $cod, $res, $var) = @_;
  my ($ref, @buf);

  return -1 unless $nod && $cod;

  # Determine the variable contribution
  if ($ref = ref($var))
  { $var = $var->as_data if $ref =~ $VALUE;
    foreach my $key (sort keys(%{$var}))
    { push(@buf, $key.q{="}.$var->{$key}.q{"});
    }
  }

  # Execute the script command
  $slf->{'_ses'} = $ctx->get_remote->get_session($nod, 1);
  return $slf->{'_ses'}->execute(join(qq{\n}, @buf, $cod), $res);
}

=head2 S<rda($node,$options[,$flag])>

This macro executes RDA with the specified options on a remote node. It treats
requests differently, depending on whether they are on local or remote
systems. When the flag is set, it captures all output lines.

It returns the command exit code when the request is executed. Otherwise, it
returns -1.

=cut

sub _m_rda
{ my ($slf, $ctx, $nod, $opt, $flg, $inc) = @_;
  my ($rem);

  return -1 unless $nod && defined($opt);

  # Execute the RDA command
  $rem = $ctx->get_remote;
  $slf->{'_ses'} = $rem->is_remote($nod)
    ? $rem->get_session($nod, 1)
    : $rem->add_local($nod);
  return $slf->{'_ses'}->rda($opt, $flg, $inc);
}

=head2 S<rexec($node,$command[,$flag])>

This macro executes the specified command on a remote node. There is no attempt
to treat the request differently if the remote node is the local node. When the
flag is set, it captures all output lines.

It returns the command exit code when the request is executed. Otherwise, it
returns -1.

To alter temporarily some attributes, you can specify a hash reference as the
command argument. It supports following keys:

=over 11

=item S<    B<'cmd'> > Command to execute

=item S<    B<'max'> > Maximum command execution time

=item S<    B<'new'> > When present, executes the command with a new connection

=back

=cut

sub _m_rexec
{ my ($slf, $ctx, $nod, $cmd, $flg) = @_;
  my ($lim, $ret);

  return -1 unless $nod && $cmd;

  # Execute the remote request
  $ret = -1;
  eval {
    local $SIG{'__WARN__'} = sub {};
    local $SIG{'ALRM'}     = sub { die "$ALR\n" } if $lim;
    local $SIG{'PIPE'}     = sub { die "$ALR\n" } if $lim;

    $cmd = $cmd->eval_as_data(1) if ref($cmd) =~ m/^RDA::Value::/;

    $slf->{'_ses'} = $ctx->get_remote->get_session($nod, 1);
    set_alarm($lim) if ($lim = $slf->{'_ses'}->get_timeout);
    $ret = $slf->{'_ses'}->command($cmd, $flg);
    clear_alarm() if $lim;
    };

  # Propagate errors
  if ($@ && $@ !~ m/^$ALR\n/)
  { clear_alarm() if $lim;
    die $@;
  }

  # Return the command result
  return $ret;
}

=head2 S<transfer($ldir,$lname,$rdir[,$rname[,$flag]])>

This macro moves a file between directories. When the flag is set, it copies
the file. It returns 1 on success or 0 on failure.

=cut

sub _m_transfer
{ my ($slf, $ctx, $ldr, $lnm, $rdr, $rnm, $flg) = @_;
  my ($src, $dst);

  return -1 unless $ldr && $lnm;

  $src = _gen_path($ldr, $lnm);
  return 0 unless -e $src;

  $rdr = $ldr unless defined($rdr);
  return 0 unless -d $rdr || mkdir($rdr,0750);  ## no critic (Number)
  $dst = _gen_path($rdr, defined($rnm) ? $rnm : $lnm);

  return $flg ? copy($src, $dst) : move($src, $dst);
}

# --- Local Internal routines -------------------------------------------------

sub _gen_path
{ my ($dir, $fil) = @_;

  return (!defined($fil)) ? $dir : ($dir eq q{.}) ? $fil :
    RDA::Object::Rda->cat_file($dir, $fil);
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Alarm|RDA::Alarm>,
L<RDA::Driver::Library|RDA::Driver::Library>,
L<RDA::Local::Unix|RDA::Local::Unix>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Item|RDA::Object::Item>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Object::Remote|RDA::Object::Remote>,
L<RDA::Object::Ssh|RDA::Object::Ssh>,
L<RDA::SDCL::Block|RDA::SDCL::Block>,
L<RDA::SDCL::Value|RDA::SDCL::Value>,
L<RDA::Text|RDA::Text>,
L<RDA::Value::Array|RDA::Value::Array>,
L<RDA::Value::List|RDA::Value::List>

=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