Re: Yet Another Tarball Script (gzip ta'boot)

[bikeNomad]

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>);
   }
######################################################################
+####