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>);
}
######################################################################
+####
Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
Read Where should I post X? if you're not absolutely sure you're posting in the right place.
Please read these before you post! —
Posts may use any of the Perl Monks Approved HTML tags:
- a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
|
For: |
|
Use: |
| & | | & |
| < | | < |
| > | | > |
| [ | | [ |
| ] | | ] |
Link using PerlMonks shortcuts! What shortcuts can I use for linking?
See Writeup Formatting Tips and other pages linked from there for more info.
|
|