#!/usr/bin/perl

BEGIN {
  sub usage {
    print "usage: tar xvfO tarfile.tar |& $0 ", 
          "/path/to/newdir\n";
    exit 1;
  }

  if ( $^O ne 'linux' ) {
    print "tar on $^O doesn't support O flag\n\n";
    usage();
  }

  -p STDIN or usage();    # make sure we're in a pipe
  @ARGV == 1 or usage();
  $main::newdir = shift(@ARGV);
  -d $main::newdir or mkdir $main::newdir;
}

use strict;
use warnings;

my $fh = ();
my $orig_dir = ();

while (<>) {
  chomp;

  # grab original root dirname from tar header
  if ( not defined $orig_dir ) {
    #($orig_dir) = m {^([^/]*)/$} ;
    # Remove /$ to allow handling sun- & alpha-made tarballs
    ($orig_dir) = m {^([^/]*)} ;
  }

  else { 
    # change root dirname in fileheader to new dirname
    if ( s{^$orig_dir/([^/]*?)}{$main::newdir/$1}x ) {
      $fh = get_newfh($_);
      next unless defined $fh; # Justin Case
    }

    # print extracted data
    else {
      print $fh $_, $/;
    }
  }
}

sub get_newfh
{
  my ($file) = shift(@_);

  # silly "open or do {...}" to handle subdirs in tar file
  open OUT, ">$file" or do { if ( $! =~ /is a directory/i) {
                               mkdir $file unless -d $file
                             } else {
                               die "$file: $!\n";
                             }
                           };
  \*OUT;
}