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

package RDA::Driver::Jar;

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

=head1 NAME

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

=head1 SYNOPSIS

 require RDA::Driver::Jar;

=head1 DESCRIPTION

The objects of the C<RDA::Driver::Jar> class are used to manage archives using
F<jar>. 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::File;
  use RDA::Text qw(get_string);
  use RDA::Object::Archive;
  use RDA::Object::Rda;
}

# 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 ($man, $msk, $opt, $sta, @cmd);

  # Determine the options
  $opt = (index($req, 's') < 0) ? '-cf' : '-cf0';
  @cmd = ($slf->{'pth'});

  # Treat manifest file
  if (index($req, 'm') < 0)
  { $opt .= 'M';
  }
  else
  { $opt .= 'm';
    $man = RDA::Object::Rda->cat_file($slf->get_info('col')->get_dir('C'),
      $slf->{'oid'}.'.MF');
    push(@cmd, $slf->get_info('man')->save($man));
  }

  # Determine the archive content
  unshift(@cmd, RDA::Object::Rda->native($slf->get_info('arc')), $opt);
  push(@cmd, '-C', $dir) if defined($dir);
  push(@cmd, @fil);
  push(@cmd, RDA::Object::Rda->current_dir) unless @fil;

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

  # Delete the manifest file
  if (defined($man))
  { 1 while unlink($man);
  }

  # Return the exit code
  return $sta;
}

=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 ($cwd, $dir, $msk, $pth, $sta);

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

  # Execute the command
  chdir($dir = $slf->{'dir'}) or die get_string('CD_PKG', $dir);
  $msk = umask(027);  ## no critic (Number)
  $sta = system(RDA::Object::Rda->native($slf->get_info('ext')), '-xf', $pth,
    @fil);
  umask($msk);
  chdir($cwd) or get_string('CD_WRK', $cwd);

  # Return the exit code
  return $sta;
}

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

This method returns the usual archive extension.

=cut

sub get_extension
{ return '.jar';
}

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