Solved

Perl Tar Archive

Posted on 2010-11-28
5
449 Views
Last Modified: 2012-05-10
I want to implement the following:
Achive all $File::Find::name files
Strip them from their full path names
After archive - delete all $File::Find::name
Delete empty folders

Something is wrong with the code because it renames only one file when using "$tar->rename($fn, $fd.'/'.$file);", or archives only one file, and every time gives me warning messages.

How to change it to process all files.
use strict;
use warnings;
use Archive::Tar;
use File::Find;


my $dir_source = 'test';

my @files = ();

find(\&archive, $dir_source); 
sub archive {
	/\.txt$/ or return;
	my $fd = $File::Find::dir;
	my $fn = $File::Find::name;
	my $file = $_;
	
	chdir("$dir_source") or die "could not cd to dir: $!";
	
	print "found $fn\n" ;
	
	$fd =~ s{^\Q$dir_source}{};
	
	push @files, $fn;	
	
	my $tar = Archive::Tar->new();
	$tar->add_files(@files);
	$tar->rename($fn, $fd.'/'.$file);
	$tar->write($fd.'.tar');
	
	unlink $fn;
	
	finddepth(sub{rmdir},'.');

}

Open in new window

0
Comment
Question by:thebourneid
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
5 Comments
 
LVL 10

Accepted Solution

by:
Tobias earned 250 total points
ID: 34228952
Dear,

You could use this sample of code to add all the .txt from the directory test :

# Create a new tar object:
my $tar = Archive::Tar->new();

# Add some files:
$tar->add_files( <test/*.txt> );
# */ fix syntax highlighing in stackoverflow.com

# Finished:
$tar->write( 'file.tar' );

Best Regards
0
 

Author Comment

by:thebourneid
ID: 34230030
I came accross this sample recently but didn't find it helpful.

Shoud I use $File::Find::name with your suggestion. I'm talking about hundreds of folders.

If I use
my $tar = Archive::Tar->new();
$tar->add_files( <$dir_source/*.txt> );
$tar->write('file.tar');

is not enough.

0
 
LVL 10

Expert Comment

by:Tobias
ID: 34230842
Dear,

Ok. Yes you are right this is not working.

The code attached work without problem, maybe you could reuse it for that it satisfy you.

Best Regards

#!/usr/bin/perl -w  
use strict; 
use warnings 'all'; 
use Archive::Tar; 
use File::Find; 
 
my $archive=$ARGV[0]; 
my $dir=$ARGV[1]; 
if ($#ARGV != 1) { 
    print "usage: tarcvf test.tar.gz directory\n"; 
    exit; 
} 
# Create inventory of files & directories 
my @inventory = (); 
find (sub { push @inventory, $File::Find::name }, $dir); 
# Create a new tar object 
my $tar = Archive::Tar->new(); 
$tar->add_files( @inventory ); 
# Write compressed tar file 
$tar->write( $archive, 9 );

Open in new window

0
 
LVL 16

Assisted Solution

by:jmatix
jmatix earned 250 total points
ID: 34230874
See if this works for you:
use warnings;
use Archive::Tar;
use File::Find;


my $dir_source = 'test';

my @files = ();

find(\&archive, $dir_source);
my $tar = Archive::Tar->new();

my @tfiles = $tar->add_files(@files);

print ($files[$_],"\n"), $tar->rename($tfiles[$_], $files[$_]) for (0..$#tfiles);

$tar->write("$dir_source.tar");
unlink for @files;
finddepth(sub{rmdir},'.');

sub archive {
	/\.txt$/ or return;
	my $fn = $File::Find::name;
	print "found $fn\n" ;
	push @files, $fn;	
}

Open in new window

0
 

Author Comment

by:thebourneid
ID: 34233968
I've test various variations and this is most close to my needs with 2 remaining problems:

The code doesn't delete emty folders
And more importantly I don't know how to be sure that only already archived files are deleted.
use strict;
use warnings;
use Archive::Tar;
use File::Find;


my $dir_source = "test";

my @files = ();

find(\&archive, $dir_source); 
sub archive {
	/\.txt$/ or return;
	my $fd = $File::Find::dir;
	my $fn = $File::Find::name;	
	
	chdir("$dir_source") or die "could not cd to dir: $!";
	
	print "found $fn\n" ;
	
	$fd =~ s{^\Q$dir_source}{};
	$fn =~ s{^\Q$dir_source}{};
	
	push @files, $fn;	
	
	my $tar = Archive::Tar->new();
	$tar->add_files(@files);
	$tar->write($fd.'.tar');

}

find(\&del_files, $dir_source); 
sub del_files {
	/\.txt$/ or return;
	my $fd = $File::Find::dir;
	my $fn = $File::Find::name;
	
	unlink $fn;
	
	finddepth(sub{rmdir},'.');

}

Open in new window

0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

On Microsoft Windows, if  when you click or type the name of a .pl file, you get an error "is not recognized as an internal or external command, operable program or batch file", then this means you do not have the .pl file extension associated with …
I have been pestered over the years to produce and distribute regular data extracts, and often the request have explicitly requested the data be emailed as an Excel attachement; specifically Excel, as it appears: CSV files confuse (no Red or Green h…
Explain concepts important to validation of email addresses with regular expressions. Applies to most languages/tools that uses regular expressions. Consider email address RFCs: Look at HTML5 form input element (with type=email) regex pattern: T…
Six Sigma Control Plans

726 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question