Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
#!/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

In reply to (code) Yet Another Gzip Tarball Script by ybiC

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • 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.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others taking refuge in the Monastery: (7)
As of 2024-03-28 13:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found