While I didn't write
Archive::Tar, I did write
Archive::Zip. Here's a version of
ybiC's program that makes zip files instead, just as a demo.
#!/usr/bin/perl -w
# zgz.pl
# pod at tail
use strict;
use Archive::Zip qw(:CONSTANTS :ERROR_CODES);
use Time::localtime;
# Config parameters
my @dirs = qw(
/var/www
/etc
); # omit trailing slash
my %parm = (
cmprlevl => '9', # compression level (2=big,fast 9=small
+,slow)
recurse => '1', # 1=yes, anythingelse=no
);
my %file = (
out => 'zgzpl.zip',
log => 'zgzpl.log',
);
# Files readable only by user running this program
umask oct 177;
open(LOG, ">$file{log}") or die "Error opening $file{log}:\n$!";
PrintLogCon("\n Launching $0\n");
TimeStamp();
PrintLogCon(
" Report versions:\n",
" Archive::Zip $Archive::Zip::VERSION\n",
" Time::localtime $Time::localtime::VERSION\n",
" Perl $]\n",
" OS $^O\n",
"\n",
);
# Get down to business
my $ArcZip = Archive::Zip -> new();
PrintLogCon(" Read directories and files:\n");
while(@dirs) {
my $dir = shift @dirs;
PrintLogCon(" $dir\n");
opendir DIR, $dir or PrintLogCon("Error opening $dir: $!\
+n");
my @infiles = (readdir DIR) or PrintLogCon("Error reading $dir: $!\
+n");
closedir DIR or PrintLogCon("Error closing $dir: $!\
+n");
# skip symlinks, but recurse directories if told to
for(@infiles) {
$_ =~ m/^\.{1,2}$/ and next;
my $absolute = "$dir/$_";
if (-l $absolute) { next; }
if ($parm{recurse}==1 and -d $absolute) {unshift @dirs,$absolute
+;next;}
if (my $member = $ArcZip -> addFile($absolute)) {
$member->desiredCompressionLevel($parm{cmprlevl});
}
else {
PrintLogCon("Error adding \"$_\" to $file{out}: $!\n");
}
}
}
PrintLogCon("\n Write zip file:\n");
$ArcZip -> writeToFileNamed($file{out})
or PrintLogCon("Error writing $file{out}: $!\n");
$file{outsize} = (stat($file{out}))[7];
PrintLogCon(
" $file{out}\n",
" $file{outsize} bytes\n",
"\n",
" $0 finished.\n"
);
TimeStamp();
close LOG or die "Error closing $file{log}: $!";
######################################################################
+####
# print messages to both console and logfile
sub PrintLogCon {
print @_;
print(LOG @_) or die "Error printing to $file{log}:\n
+$!";
}
######################################################################
+####
# print date/timestamp to both console and logfile
sub TimeStamp {
printf " %4d-%2d-%2d %2d:%2d:%2d\n\n",
localtime -> year()+1900,
localtime -> mon()+1,
localtime -> mday(),
localtime -> hour(),
localtime -> min(),
localtime -> sec(),
;
printf LOG " %4d-%2d-%2d %2d:%2d:%2d\n\n",
localtime -> year()+1900,
localtime -> mon()+1,
localtime -> mday(),
localtime -> hour(),
localtime -> min(),
localtime -> sec(),
or die "Error printing to $file{log}:\n$!";
}
######################################################################
+####
# for testing purposes
sub Pause {
print"Ctrl+c to abort, <enter> to continue \n";
(<STDIN>);
}
######################################################################
+####
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.