view release on metacpan or  search on metacpan

lib/Archive/Tar/Stream.pm  view on Meta::CPAN

  my $header = $Self->BlankHeader(@_, name => $name, size => $size);

  return $size ? $Self->WriteFromFh($fh, $header) : $Self->WriteHeader($header);
}

=head2 AddLink

   my $header = $ts->AddLink($name, $linkname, %extra);

Adds a symlink to the output filehandle.

See TARHEADER for documentation of the header fields.

Returns the complete header that was written.

=cut

sub AddLink {
  my $Self = shift;
  my $name = shift;
  my $linkname = shift;

  my $header = $Self->BlankHeader(typeflag => 2, @_, name => $name, linkname => $linkname);

  return $Self->WriteHeader($header);
}

=head2 StreamCopy

Streams all records from the input filehandle and provides
an easy way to write them to the output filehandle.

Requires: infh
Optional: outfh - required if you return 'KEEP'

    $ts->StreamCopy(sub {
        my ($header, $outpos, $fh) = @_;
        # ...
        return 'KEEP';
    });

The chooser function can either return a single 'action' or
a tuple of action and a new header.

The action can be:
   KEEP - copy this file as is (possibly changed header) to output tar
   EDIT - re-call $Chooser with filehandle
   SKIP - skip over the file and call $Chooser on the next one
   EXIT - skip and also stop further processing

EDIT mode:

the file will be copied to a temporary file and the filehandle passed to
$Chooser.  It can truncate, rewrite, edit - whatever.  So long as it updates
$header->{size} and returns it as $newheader it's all good.

you don't have to change the file of course, it's also good just as a way to
view the contents of some files as you stream them.

A standard usage pattern looks like this:

  $ts->StreamCopy(sub {
    my ($header, $outpos, $fs) = @_;

    # simple checks
    return 'KEEP' if do_want($header);
    return 'SKIP' if dont_want($header);

    return 'EDIT' unless $fh;

    # checks that require a filehandle
  });

=cut

sub StreamCopy {
  my $Self = shift;
  my $Chooser = shift;

  while (my $header = $Self->ReadHeader()) {
    my $pos = $header->{_pos};
    if ($Chooser) {
      my ($rc, $newheader) = $Chooser->($header, $Self->{outpos}, undef);

      my $TempFile;
      my $Edited;

      # positive code means read the file
      if ($rc eq 'EDIT') {
        $Edited = 1;
        $TempFile = $Self->CopyToTempFile($header->{size});
        # call chooser again with the contents
        ($rc, $newheader) = $Chooser->($newheader || $header, $Self->{outpos}, $TempFile);
        seek($TempFile, 0, 0);
      }

      # short circuit exit code
      return if $rc eq 'EXIT';

      # NOTE: even the size could have been changed if it's an edit!
      $header = $newheader if $newheader;

      if ($rc eq 'KEEP') {
        print "KEEP $header->{name} $pos/$Self->{outpos}\n" if $VERBOSE;
        if ($TempFile) {
          $Self->WriteFromFh($TempFile, $header);
        }
        # guarantee safety by getting everything into a temporary file first
        elsif ($Self->{safe_copy} and $header->{size}) {
          $TempFile = $Self->CopyToTempFile($header->{size});
          $Self->WriteFromFh($TempFile, $header);
        }
        else {
          $Self->WriteCopy($header);
        }
      }

      # anything else means discard it
      elsif ($rc eq 'SKIP') {
        if ($TempFile) {