Category: | Utility Scripts |
Author/Contact Info | ybiC |
Description: | I wrote this ditty to automate file copies, while retaining last-modified timestamps.
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:
|
#!/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 |
Back to
Code Catacombs