view release on metacpan or  search on metacpan

lib/Archive/Ar/Libarchive.pm  view on Meta::CPAN

  $ret || undef;
}


sub read_memory
{
  my($self, $data) = @_;

  open my $fh, '<', \$data;
  binmode $fh;
  my $ret = $self->read($fh);

  $ret;
}


sub chmod
{
  my($self, $filename, $mode) = @_;
  $self->_chmod($filename, $mode + 0 eq $mode ? $mode : oct($mode));
}


sub chown
{
  my($self, $filename, $uid, $gid) = @_;
  $self->_chown($filename, $uid, $gid);
}


sub remove
{
  my $self = shift;
  my $count = 0;
  foreach my $pathname (@{ ref $_[0] ? $_[0] : \@_ })
  {
    $count += $self->_remove($pathname);
  }
  $count;
}


sub list_files
{
  my $list = shift->_list_files;
  wantarray ? @$list : $list; ## no critic (Community::Wantarray)
}


sub add_files
{
  my $self = shift;
  my $count = 0;
  foreach my $filename (@{ ref $_[0] ? $_[0] : \@_ })
  {
    unless(-r $filename)
    {
      $self->_error("No such file: $filename");
      next;
    }
    my @props = stat($filename);
    unless(@props)
    {
      $self->_error("Could not stat $filename.");
      next;
    }

    open(my $fh, '<', $filename) || do {
      $self->_error("Unable to open $filename $!");
      next;
    };
    binmode $fh;
    # TODO: we don't check for error on the actual
    # read operation (but then nethier does
    # Archive::Ar).
    my $data = do { local $/; <$fh> };
    close $fh;

    $self->add_data(File::Basename::basename($filename), $data, {
      date => $props[9],
      uid  => $props[4],
      gid  => $props[5],
      mode => $props[2],
      size => length $data,
    });
    $count++;
  }

  return unless $count;
  $count;
}


sub add_data
{
  my($self, $filename, $data, $filedata) = @_;
  $filedata ||= {};
  $self->_add_data($filename, $data, $filedata->{uid} || 0, $filedata->{gid} || 0, $filedata->{date} || time, $filedata->{mode} || oct(100644));
  use bytes;
  length $data;
}


sub write
{
  my($self, $filename) = @_;
  if(defined $filename)
  {
    my $fh;

    if(ref $filename)
    {
      return $self->_error("Not a filehandle") unless eval{*$filename{IO}} or $filename->isa('IO::Handle');
      $fh = $filename;

      return $self->_write_to_callback(sub {
        my($archive, $buffer) = @_;
        print $fh $buffer;
        length $buffer;
      });
    }