# Tar.pm: Class Used to Manage Archives using Tar

package RDA::Driver::Tar;

# $Id: Tar.pm,v 1.8 2015/05/08 18:09:24 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Driver/Tar.pm,v 1.8 2015/05/08 18:09:24 RDA Exp $
#
# Change History
# 20150508  MSC  Improve the documentation.

=head1 NAME

RDA::Driver::Tar - Class Used to Manage Archives using Tar

=head1 SYNOPSIS

 require RDA::Driver::Tar;

=head1 DESCRIPTION

The objects of the C<RDA::Driver::Tar> class are used to manage archives using
F<tar>. It is a subclass of L<RDA::Object::Archive|RDA::Object::Archive>.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::Handle;
  use RDA::Text qw(get_string);
  use RDA::Object::Archive;
  use RDA::Object::Rda qw($DIR_PERMS);
}

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

# Define the global private constants

# Define the global private variables

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

=head2 S<$h-E<gt>create($opt[,$dir[,$fil,...]])>

This method creates the archive file. Unless files are specified as arguments,
it includes recursively the whole directory in the archive. By default, it
compresses the files but does not create a manifest file.

It supports the following request options:

=over 9

=item B<    'm' > Creates a manifest file.

=item B<    's' > Stores only.

=back

It returns the exit code.

=cut

sub create
{ my ($slf, $req, $dir, @fil) = @_;
  my ($cwd, $ext, $man, $msk, $pth, @cmd);

  # Determine the archive path
  $cwd = $slf->{'cwd'};
  $pth = RDA::Object::Rda->cat_file($cwd, $pth)
    unless RDA::Object::Rda->is_absolute($pth = $slf->{'pth'});

  # Prepare the command
  @cmd = (RDA::Object::Rda->native($slf->get_info('arc')), '-cf', $pth);
  push(@cmd, '-C', $dir) if defined($dir);
  push(@cmd, @fil);
  push(@cmd, RDA::Object::Rda->current_dir) unless @fil;

  # Treat the manifest file
  unless (index($req, 'm') < 0)  ## no critic (Unless)
  { $man = RDA::Object::Rda->create_dir(defined($dir)
      ? RDA::Object::Rda->cat_dir($dir, 'META-INF')
      : $dir, $DIR_PERMS);
    $slf->get_info('man')->save(RDA::Object::Rda->cat_file($man,
      'MANIFEST.MF'));

    push(@cmd, RDA::Object::Rda->cat_file('META-INF', 'MANIFEST.MF')) if @fil;
  }

  # Execute the command
  $msk = umask(027);  ## no critic (Number)
  system(@cmd);
  umask($msk);

  # Compress the file
  unless ($?  ## no critic (Unless)
    || ref($ext = $slf->get_info('pck')) ne 'ARRAY')
  { ($ext, @cmd) = @{$ext};
    $slf->{'pth'} .= $ext;
    system(@cmd, $pth);
  }

  # Return the exit code
  return $?;
}

=head2 S<$h-E<gt>extract($arc,$flg,$fil...)>

This method extracts files from the specified archive file. It stores the files
in the directory associated to the current archive.

=cut

sub extract
{ my ($slf, $arc, $flg, @fil) = @_;
  my ($msk, $sta);

  $msk = umask(027);
  $sta = system(RDA::Object::Rda->native($slf->get_info('ext')), '-qoC', $arc,
    @fil, '-d', $slf->{'dir'});
  umask($msk);
  return $sta;
}

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

This method returns the usual archive extension.

=cut

sub get_extension
{ return '.tar';
}

1;

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Object::Archive|RDA::Object::Archive>,
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