# PACKAGE.pm: Packaging Command Library

package RDA::Request::PACKAGE;

# $Id: PACKAGE.pm,v 1.18 2015/11/16 10:29:21 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Request/PACKAGE.pm,v 1.18 2015/11/16 10:29:21 RDA Exp $
#
# Change History
# 20151116  MSC  Extend verbosity control.

=head1 NAME

RDA::Request::PACKAGE - Packaging Command Library

=head1 SYNOPSIS

 require RDA::Request::PACKAGE;

=head1 DESCRIPTION

The objects of the C<RDA::Request::PACKAGE> class are used to manage packaging
operations.

The following methods are available:

=cut

use strict;

BEGIN
{ use Cwd;
  use Exporter;
  use RDA::Text qw(get_string);
  use RDA::Object::Archive;
  use RDA::Object;
  use RDA::Object::Message;
  use RDA::Object::Rda;
}

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

# Define the global private constants

# Define the global private variables
my %tb_cmd = (
  'PACKAGE.FILES'   => \&_do_files,
  'PACKAGE.RESULTS' => \&_do_results,
  );

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

=head2 S<$h = RDA::Request::PACKAGE-E<gt>new($agt)>

The object constructor. This method enables you to specify the agent reference
as an argument.

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

=over 10

=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<'_dsp'> > Reference to the display control object when verbose

=back

Internal keys are prefixed by an underscore.

=cut

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

  # Create the library object and return the object reference
  return bless {
    _agt => $agt,
    _cfg => $agt->get_config,
    _col => $agt->get_collector,
    _dsp => $agt->is_verbose,
    }, ref($cls) || $cls;
}

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

This method deletes the library object.

=cut

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

=head2 S<$h-E<gt>exec_command($req)>

This method executes the command specified in the message.

=cut

sub exec_command
{ my ($slf, $req) = @_;

  my $cmd = $req->{'msg'};
  return exists($tb_cmd{$cmd})
    ? &{$tb_cmd{$cmd}}($slf, $req)
    : $req->error('NotImplemented', get_string('BAD_COMMAND', $cmd));
}

=head1 PACKAGE COMMANDS

=head2 PACKAGE.FILES - File package command

This command packages files. It supports the following attributes:

=over 15

=item B<  attach>

When true, attaches the archive content to the response message.

=item B<  compression>

Specifies an alternative compression level (0 to 9).

=item B<  directory>

Specifies the base directory (the current directory by default).

=item B<  files>

Lists the files or the directories to include in the package (the whole base
directory by default).

=item B<  location>

Specifies an alternative archive location.

=item B<  manifest>

Provides additional manifest entries as a list of key-value pairs.

=item B<  name>

Specifies an alternative archive name.

=item B<  verbose>

When specified, controls the packaging verbosity.

=back

=cut

sub _do_files
{ my ($slf, $req) = @_;
  my ($arc, $dsp, $key, $man, $nam, $sta, $val, @man);

  # Validate the parameters
  return $req->error('NoName')
    unless ($nam = $req->get_first('name'));
  $dsp = _is_verbose($slf, $req->get_first('verbose'));

  # Package the files
  eval
  { $dsp->dsp_line(get_string('V_Files')) if $dsp;

    # Create the archive and declare the manifest
    $arc = RDA::Object::Archive->new($slf->{'_col'});
    $arc->set_compression($val)
      if defined($val = $req->get_first('compression'));
    if (@man = $req->get_value('manifest'))
    { $man = $arc->get_manifest;
      while (($key, $val) = splice(@man, 0, 2))
      { $man->set_info($key, $val)
          if defined($key) && $key =~ m/^[A-Z][\w\-]*$/;;
      }
    }

    # Package the files
    $arc = $arc->package($nam,
      $req->get_first('location', $slf->{'_cfg'}->get_group('D_CWD')),
      $req->get_first('directory', RDA::Object::Rda->current_dir),
      $req->get_value('files'));
    die get_string('ERR_PACKAGE', $sta) if ($sta = $arc->get_status);
    $arc = $arc->get_path;
    $dsp->dsp_line(get_string('VI_Package', $arc)) if $dsp
  };

  # Indicate the completion status
  return _reply($req, $@, $arc);
}

sub _is_verbose
{ my ($slf, $flg) = @_;

  return
    !defined($flg) ? $slf->{'_dsp'} :
    $flg           ? $slf->{'_agt'}->get_display:
                     undef;
}

=head2 PACKAGE.RESULTS - Result package command

This command packages the overview files and all collection results. It
supports the following attributes:

=over 15

=item B<  attach>

When true, attaches the archive content to the response message.

=item B<  compression>

Specifies an alternative compression level (0 to 9).

=item B<  display>

Controls when the packaging text must be displayed (true by default).

=item B<  name>

Specifies an alternative result archive name.

=item B<  location>

Specifies an alternative result archive location.

=item B<  save>

Allows to overwrite the incremental save indicator.

=item B<  timestamp>

When true, includes a time stamp in the archive name.

=item B<  verbose>

When specified, controls the packaging verbosity.

=back

=cut

sub _do_results
{ my ($slf, $req) = @_;
  my ($arc, $beg, $cfg, $col, $dsp, $nam, $sav, $sta, $val);

  $cfg = $slf->{'_cfg'};
  $col = $slf->{'_col'};
  $dsp = _is_verbose($slf, $req->get_first('verbose'));
  eval
  { # Initialize the packaging environment
    $dsp->dsp_line(get_string('V_Results')) if $dsp;
    $arc = RDA::Object::Archive->new($col);
    $arc->set_compression($val)
      if defined($val = $req->get_first('compression'));

    # Determine the archive name
    unless (defined($nam = $req->get_first('name')) ||
            defined($nam = $col->get_first('PACKAGE.W_NAME')))
    { $nam = 'RDA_'.$col->get_oid;
      $nam .= q{_}.$cfg->get_node
        unless $col->get_first('FILTER.B_ENABLED');
      $nam .= _fmt_time()
        if $req->get_first('timestamp', $col->get_first('PACKAGE.B_KEEP'));
    }

    # Create the result archive
    $col->suspend_log;
    $arc = $arc->package($nam,
      $req->get_first('location', $cfg->get_group('D_CWD')),
      $col->get_data);
    $sta = $arc->get_status;
    $arc = $arc->get_path;
    $col->log('P', $arc, $sta);
    die get_string('ERR_PACKAGE', $sta) if $sta;

    # Execute the post-collect steps and save the result set definition
    $sav = $req->get_first('save');
    $col->save unless $col->is_new
                   || $col->post('POST_PACKAGE', $sav) == 0
                   || defined($sav)
                   || $col->should_save;

    # Display the thanks message
    if ($req->get_first('display', $col->get_first('DEFAULT.B_TEXT', 1)))
    { # Display the report message
      $beg = $cfg->get_value('B_CASE')
        ? 'RDA__start.htm'
        : 'rda__start.htm';
      if ($cfg->is_windows)
      { $slf->{'_agt'}->submit(q{.}, 'DISPLAY.DSP_TEXT',
          name    => 'Packaging/Windows',
          set_arc => $arc,
          set_beg => $cfg->cat_file($col->get_data(1), $beg));
      }
      elsif ($cfg->is_cygwin)
      { $slf->{'_agt'}->submit(q{.}, 'DISPLAY.DSP_TEXT',
          name    => 'Packaging/Cygwin',
          set_arc => $arc,
          set_beg => $cfg->cat_file($col->get_data(1), $beg));
      }
      elsif ($cfg->is_vms)
      { $slf->{'_agt'}->submit(q{.}, 'DISPLAY.DSP_TEXT',
          name    => 'Packaging/Vms',
          set_arc => $arc,
          set_beg => $beg,
          set_dat => $col->get_data(1));
      }
      else
      { my ($dir, $ftp);

        $ftp = $col->get_data(1);
        if ($dir = $slf->{'_agt'}->get_env('HOME'))
        { $dir = $cfg->cat_dir($dir);
          $ftp =~ s{^(/export)?$dir/}{};
        }
        $slf->{'_agt'}->submit(q{.}, 'DISPLAY.DSP_TEXT',
          name    => 'Packaging',
          set_arc => $arc,
          set_beg => $beg,
          set_dat => $col->get_data(1),
          set_ftp => $ftp);
      }
    }
    elsif ($dsp)
    { $dsp->dsp_line(get_string('VI_Package', $arc));
    }
  };

  # Indicate the completion status
  return _reply($req, $@, $arc);
}

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

# Generate a time stamp
sub _fmt_time
{ my @tbl = gmtime(time);

  return sprintf('_%04d%02d%02d_%02d%02d%02d', 1900 + $tbl[5], $tbl[4] + 1,
    $tbl[3], $tbl[2], $tbl[1], $tbl[0]);
}

# Generate the response
sub _reply
{ my ($req, $err, $arc) = @_;

  return
    $req->add_error($err)->has_errors ?
      $req->error('Package') :
    $req->get_first('attach') ?
      $req->new('OK.Package', archive => $arc)->add_file($arc) :
    $req->new('OK.Package', archive => $arc);
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Archive|RDA::Object::Archive>,
L<RDA::Object::Config|RDA::Object::Config>,
L<RDA::Object::Collect|RDA::Object::Collect>,
L<RDA::Object::Display|RDA::Object::Display>,
L<RDA::Object::Message|RDA::Object::Message>,
L<RDA::Object::Rda|RDA::Object::Rda>,
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