Solved

Perl Tar Archive

Posted on 2010-11-28
5
426 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

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Suggested Solutions

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 …
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…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

708 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

17 Experts available now in Live!

Get 1:1 Help Now