#!/usr/bin/perl

use strict;
use Archive::Tar;

my $wdir = "U:/EMM loads";

# load an array of tar file names:

open( DIR, $wdir ) or die "$wdir: $!";
my @tarballs = grep /\.tar$/, readdir DIR;
closedir DIR;

# for each tar file, yank out the "toc" file:

for my $tarball ( @tarballs ) {
    my $tar = Archive::Tar->new( "$wdir/$tarball" );
    my ($toc) = grep { $_->name =~ m{/toc$} } $tar->get_files;

  # make up a local name for this toc file, based on the tarball name:

    ( my $tocname = $tarball ) =~ s/tar$/toc/;

  # write the toc file data to the local toc file:

    open( TOC, ">", $tocname ) or die "$tocname: $!";
    print TOC $toc->get_content;
    close TOC;
}