Perl Archive::Tar
I want to archive all txt files with File::Find, delete the source files and remove empty directories.
I'm having difficulties renaming the files with '$tar->rename( );' because I'd like to to strip them from their full path names and use only parent directory/*.txt, but whatever I try the code renames only one file.
I don't know where is the appropriate place to execute the 'unlink' function.Thanks.
use strict;
use warnings;
use Archive::Tar;
use File::Find;
use File::Basename;
my $dir = "E:/";
my @files = ();
find(\&archive, $dir);
sub archive {
/\.txt$/ or return;
my $fd = $File::Find::dir;
my $fn = $File::Find::name;
my $folder = basename($fd);
my $file = $_;
push @files, $fn;
my $tar = Archive::Tar->开发者_StackOverflow中文版;new();
$tar->add_files(@files);
$tar->rename( $fn, $folder."\\".$file );
$tar->write($fd.'.tar');
unlink $fn;
finddepth(sub{rmdir},'.');
}
You are using the File::Find interface incorrectly. The archive sub gets called once on every file found. You end up creating a new tar on every call, adding a single file to it and writing it out.
Correction: You end up trying to add all the previously found files, but you've already unlinked all except the last one.
Let's do this in small steps - first find and classify all .txt files according to directory, then add them to relevant tar files, and finally clean up:
my $dir = "E:/";
my %txt_files = ();
find(\&classify, $dir);
sub classify{
/\.txt$/ or return;
my $fd = $File::Find::dir;
my $fn = $File::Find::name;
push @{$txt_files{$fd}||=[]}, $fn;
}
foreach my $folder (keys %txt_dirs) {
my @files = @{$txt_files{$folder}};
my $foldername = basename($folder);
my $tar = Archive::Tar->new();
$tar->add_files(@files);
$tar->rename( $_, $foldername."/".basename($_))
for @files;
$tar->write($folder.'.tar');
}
# remove all the txt files we've found
unlink for map {@{$_}} values %txt_files;
# try to remove the directories that contained the txt files
eval {rmdir} for keys %txt_files;
精彩评论