Solved

Perl Tar Archive

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

Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
How to strip .csv from file name 9 81
Perl Script - Remove column of data based on column value 2 51
Replace  text in a file 2 104
Log File Creation with Header and Footer 17 93
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 …
In the distant past (last year) I hacked together a little toy that would allow a couple of Manager types to query, preview, and extract data from a number of MongoDB instances, to their tool of choice: Excel (http://dilbert.com/strips/comic/2007-08…
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…
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…

786 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