Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

(code) Yet Another Gzip Tarball Script

by ybiC (Prior)
on Jun 04, 2001 at 03:38 UTC ( [id://85385]=sourcecode: print w/replies, xml ) Need Help??
Category: Utility Scripts
Author/Contact Info ybiC
Description: I wrote this ditty to automate file copies, while retaining last-modified timestamps.
  1. Backup system configs, web directories, and perl scripts on 4 computers.
  2. Make it easy to keep perl scripts synchronized across the same 4 PCs.

Create gzipped tarball of all files in specified directories.   Status and error messages written to console and logfile.   Selectable compression level, recursion(y/n), log and dest files via commandline switches.   Tested with Perl5.00503/Debian2.2r3, ActivePerl5.6/Win2k, Perl5.6.1/Cygwin/Win2k.

Sample run logfile at tail of pod.   Critique, corrections and comments wildly welcomed.

Thanks to Vynce, mlong, bikeNomad, zdog, Beatnik, clintp, Petruchio and DrZaius for suggestions, tips and pointers.   Oh yeah, and some guy named vroom, too.

Latest updates   2001-06-05 14:25 CDT

Correction:
Our very own bikeNomad wrote Archive::Zip, not Archive::Tar. 

#!/usr/bin/perl -wT

# tgz.pl
# pod at tail

use strict;
use Archive::Tar;
use Getopt::Long;
use Time::localtime;


# List of target directories (omit trailing slash)
my @dirs = qw(
   /var/www
   /etc
   );

# Accept commandline switches
my (%parm, %file);
GetOptions(
   'recurse!'   => \$parm{recurse},
   'cmprlevl=s' => \$parm{cmprlevl},
   'outfile=s'  => \$file{out},
   'logfile=s'  => \$file{log}, 
   );

# Default values if no commandline parameters
$parm{recurse}  ||= 0;         # 1=yes 0=no
$parm{cmprlevl} ||= 9;         # compression level (2=big,fast 9=small
+,slow)
$file{out}      ||= 'tgzpl.tar.gz';
$file{log}      ||= 'tgzpl.log';

# Untaint commandline parameters
Usage() unless ($parm{cmprlevl} =~ (/^[2-9]$/));
Usage() unless ($file{out}      =~ (/^.*$/));
Usage() unless ($file{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();


# Get down to business
my $ArcTar = Archive::Tar -> 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;}
      unless ($ArcTar -> add_files("$absolute")) {
         PrintLogCon("Error adding \"$_\" to $file{out}: $!\n");
         }
      }
   }
PrintLogCon("\n    Write and compress tgzball\n");
$ArcTar -> write($file{out}, $parm{cmprlevl});


# Wrapitup
$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}: $!";

######################################################################
+####
sub Usage {
   print(
      "\n",
      "   D'oh!  Looks like you entered an option that $0 didn't like.
+\n",
      "\n",
      "   tgz.pl\n",
      "     --recurse\n",
      "     --norecurse         (default)\n",
      "     --comprlevl=[2-9]   (default is 9)\n",
      "     --outfile=path/file (default is ./tgzpl.tar.gz)\n",
      "     --logfile=path/file (default is ./tgzpl.log)\n",
      "\n",
      "   Options can also be abreviated:\n",
      "   (the '=' is optional as well)\n",
      "     -r \n",
      "     -n \n",
      "     -c [2-9]\n",
      "     -o path/file\n",
      "     -l path/file\n",
      "\n",
      "   Archive::Tar    $Archive::Tar::VERSION\n",
      "   Getopt::Long    $Getopt::Long::VERSION\n",
      "   Time::localtime $Time::localtime::VERSION\n",
      "   Perl            $]\n",
      "   OS              $^O\n",
      "\n",
      );
      exit;
   }
######################################################################
+####
# 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>);
   }
######################################################################
+####

=head1 Name

 tgz.pl

=head1 Description

 Create gzipped tarball of all files in specified directories.
 Status and error messages written to console and logfile.
 Selectable compression level, recursion(y/n),
   log and dest files selectable via commandline switches.

=head1 Requires

 Archive::Tar  http://search.cpan.org/search?dist=Archive-Tar
 Getopt::Long  http://search.cpan.org/search?dist=Getopt-Long
 Perl          http://www.cpan.org/ports/
 gzip          http://www.gzip.org/

=head1 Tested

 Archive::Tar    0.22
 Getopt::Long    2.25 and 2.19
 Time::localtime 1.01
 gzip            1.13
 Perl            5.00503
 Debian          2.2r3 

 Archive::Tar    0.072
 Getopt::Long    2.23
 Time::localtime 1.01
 gzip            1.2.4
 ActivePerl      5.006
 MSWin32         5.0 b2195 sp1

 Archive::Tar    0.22
 Getopt::Long    2.24
 Time::localtime 1.01
 gzip            1.2.4
 Perl            5.006001
 Cygwin          1.1.8-1
 MSWin32         5.0 b2195 sp1

=head1 Updates

 2001-06-04  12:40
   Retest on Win32 ActivePerl, and on Cygwin.
   Add Getopt::Long abreviations to Usage().
   '--recurse' option with no argument.
   Untaint commandline switches.
   Usage().
   Getopt::Long commandline switches.
 2001-06-03  21:40
   Post to PerlMonks (Code Catacombs->Utility Scripts).
   Unsubify 'report versions' since only done once.
   Test with:
     Cygwin Win2kPro
     ActivePerl Win2kPro
 2001-06-02 
   Configurable recursion(y/n) and compression level.
   Timestamp at start and end of run.
   Add umask for bit o'security.
   Print to logfile in addition to console.
   Depth-first recursion instead of width-first
     (while+shift+unshift instead of for+push)
   Display outfile size with 'stat'.
   Filetest to exclude symlinks.
     (avoid endless looop on Debian /etc/apache/conf->./)
     (no read-perm check on purpose, so errmsg on unreadable file(s))
   Add "qw" to @dirs and move comment out of parens.
 2001-06-01
   Directory recursion.
   Initial working code
     Debian 2.2r3

=head1 Todos

 Archive::Zip, File::Find, or File::Recurse instead of hand-rolled rec
+ursion.
 Good regex instead of blind untaint outfile and logfile from commandl
+ine.
 --nolog option where $file{log} = '/dev/null'.
 Reduce untaint redundancy.
 Reduce TimeStamp() redundancy.
 Make logfile 'live'.
 Add $version reporting.

=head1 Author

 ybiC

=head1 Credits

 Thanks to:
   Vynce, mlong, bikeNomad, zdog, and Beatnik for recursion suggestion
+s,
   Petruchio for assorted tips,
   clintp for sane way to add elts to list while looping through same 
+list,
   DrZaius for slick Getopt::Long pointers,
 Oh yeah, and some guy named vroom, too.

=head1 Sample logfile of tgz.pl -r -c 9

  Launching tgz.pl
  2001- 6- 4    3:41:46

    Read directories and files
      /var/www
      /var/www/HOWTO.ps
      /var/www/Webalizer
      /etc
      /etc/apache
      /etc/Net
      /etc/imlib
      /etc/logrotate.d
      /etc/cron.d
      /etc/cron.monthly
      /etc/rcS.d
      /etc/rc6.d
      /etc/rc5.d
      /etc/rc4.d
      /etc/rc3.d
      /etc/rc2.d
      /etc/rc1.d
      /etc/rc0.d
      /etc/rc.boot
      /etc/cron.weekly
      /etc/chatscripts
Error opening /etc/chatscripts: Permission denied
Error reading /etc/chatscripts: Permission denied
Error closing /etc/chatscripts: Permission denied
      /etc/ppp
Error opening /etc/ppp: Permission denied
Error reading /etc/ppp: Permission denied
Error closing /etc/ppp: Permission denied
      /etc/network
      /etc/cron.daily
      /etc/default
      /etc/apt
      /etc/init.d

    Write and compress tgzball
      /home/me/tgzpl.tar.gz
      25293464 bytes

  tgz.pl finished.
  2001- 6- 4    3:43:11

=cut
Replies are listed 'Best First'.
Re: Yet Another Tarball Script (gzip ta'boot)
by bikeNomad (Priest) on Jun 04, 2001 at 04:28 UTC
    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>);
   }
######################################################################
+####

    [download]
[reply]
[d/l]
Re: Yet Another Tarball Script (gzip ta'boot)
by DrZaius (Monk) on Jun 04, 2001 at 06:01 UTC
    Why no command line? Try changing your hash to this: 
    use Getopt::Long;

my (%parm, %file);

GetOptions(
            'recurse'  => \$parm{recurse},
            'cmprlevl' => \$parm{cmprlevl},
            'outfile'  => \$file{out},
            'logfile'  => \$file{log} 
          );

$parm{recurse}  ||= 1;
$parm{cmprlevl} ||= 9;
$parm{out}      ||= 'tgzpl.tar.gz';
$parm{log}      ||= 'tgzpl.log';

    [download]
    Now you can use 'gnu' long format args with your program. For example, tgz.pl --cmprlevl=3. Don't forget to untaint these values as well.
[reply]
[d/l]
Re: Yet Another Gzip Tarball Script (New and Improved)
by Beatnik (Parson) on Jun 04, 2001 at 13:06 UTC
    I actually wrote something similar (but skinnier) a few weeks ago... network backup thing :)

    Greetz
    Beatnik
    ... Quidquid perl dictum sit, altum viditur.
[reply]

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: sourcecode [id://85385]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others goofing around in the Monastery: (7)
As of 2024-04-18 03:07 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found