Solved

Perl Tar Archive

Posted on 2010-11-28
5
429 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
  • 2
  • 2
5 Comments
 
LVL 10

Accepted Solution

by:
MadShiva 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:MadShiva
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Perl strange behaviour 5 69
Perl, group, sort, count question 6 117
add a syntax to a csv file 8 98
combine multiple lines 2 44
I've just discovered very important differences between Windows an Unix formats in Perl,at least 5.xx.. MOST IMPORTANT: Use Unix file format while saving Your script. otherwise it will have ^M s or smth likely weird in the EOL, Then DO NOT use m…
Checking the Alert Log in AWS RDS Oracle can be a pain through their user interface.  I made a script to download the Alert Log, look for errors, and email me the trace files.  In this article I'll describe what I did and share my script.
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…
Video by: Mark
This lesson goes over how to construct ordered and unordered lists and how to create hyperlinks.

895 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now