File-Rotate-Backup-0.13/0000755000076500007650000000000010730375230013107 5ustar dondonFile-Rotate-Backup-0.13/Artistic0000444000076500007650000001373710716470422014630 0ustar dondon The "Artistic License" Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder as specified below. "Copyright Holder" is whoever is named in the copyright or copyrights for the package. "You" is you, if you're thinking about copying or distributing this Package. "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as uunet.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) give non-standard executables non-standard names, and clearly document the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End File-Rotate-Backup-0.13/INSTALL0000644000076500007650000000025007644107067014150 0ustar dondonCopyright (c) 2003 Don Owens See the COPYRIGHT section in Backup.pm for usage and distribution rights. INSTALLATION perl Makefile.PL make make test make install File-Rotate-Backup-0.13/lib/0000755000076500007650000000000010730375230013655 5ustar dondonFile-Rotate-Backup-0.13/lib/File/0000755000076500007650000000000010730375230014534 5ustar dondonFile-Rotate-Backup-0.13/lib/File/Rotate/0000755000076500007650000000000010730375230015772 5ustar dondonFile-Rotate-Backup-0.13/lib/File/Rotate/Backup/0000755000076500007650000000000010730375230017177 5ustar dondonFile-Rotate-Backup-0.13/lib/File/Rotate/Backup/Copy.pm0000644000076500007650000002354710027220163020453 0ustar dondon# -*-perl-*- # Creation date: 2003-04-12 22:43:55 # Authors: Don # Change log: # $Id: Copy.pm,v 1.10 2004/03/21 04:56:19 don Exp $ use strict; { package File::Rotate::Backup::Copy; use vars qw($VERSION); $VERSION = do { my @r=(q$Revision: 1.10 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r }; use File::Spec; use Fcntl (); sub new { my ($proto, $params) = @_; $params = {} unless ref($params) eq 'HASH'; my $self = bless { _params => $params }, ref($proto) || $proto; return $self; } sub copy { my ($self, $src, $dst) = @_; if (-l $src or -f $src) { return $self->_copySymlinkOrFile($src, $dst); } elsif (-d $src) { return $self->_copyDirectoryRecursive($src, $dst); } } sub _copyDirectoryRecursive { my ($self, $src, $dst) = @_; my ($src_vol, $src_dirs, $src_file) = File::Spec->splitpath($src); my ($dst_vol, $dst_dirs, $dst_file) = File::Spec->splitpath($dst); if (-e $dst and -d $dst) { # if dst is a directory, add file name to end of path my $dir = File::Spec->catdir($dst_dirs, $dst_file); $dst = File::Spec->catpath($dst_vol, $dir, $src_file); } $self->_copyOneFile($src, $dst); my $cur_dir = File::Spec->curdir; my $parent_dir = File::Spec->updir; local(*DIR); opendir(DIR, $src) or return undef; my @files = grep { $_ ne $cur_dir and $_ ne $parent_dir } readdir DIR; closedir DIR; foreach my $file (@files) { my $new_src_dir = File::Spec->catdir($src_dirs, $src_file); my $src_path = File::Spec->catpath($src_vol, $new_src_dir, $file); $self->copy($src_path, $dst); } } sub _copySymlinkOrFile { my ($self, $src, $dst) = @_; my ($src_vol, $src_dirs, $src_file) = File::Spec->splitpath($src); my ($dst_vol, $dst_dirs, $dst_file) = File::Spec->splitpath($dst); if (-e $dst and -d $dst) { # if dst is a directory, add file name to end of path my $dir = File::Spec->catdir($dst_dirs, $dst_file); $dst = File::Spec->catpath($dst_vol, $dir, $src_file); } # FIXME: should handle $dst being a symlink $self->debugPrint(5, "src_path is $src_dirs, $src_file => $src\n"); $self->debugPrint(5, "dst_path is $dst_dirs, $dst_file => $dst\n"); return $self->_copyOneFile($src, $dst); } sub _copyOneFile { my ($self, $src_path, $dst_path) = @_; if ($self->_isSameFile($src_path, $dst_path)) { return 0; } # find out what kind of file it is my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat($src_path); my $permissions = $mode & 07777; $self->debugPrint(1, "$src_path ==> $dst_path\n"); if (-l $src_path) { # symlink $self->debugPrint(9, "$src_path is a symbolic link\n"); my $link_content = readlink $src_path; return undef unless symlink $link_content, $dst_path; # FIXME: set up owner and group of symlink } elsif (-f $src_path) { # need the full path here instead of the _ filehandle # because the -l does an lstat # plain file my $size = -s _; $self->debugPrint(9, "$src_path is a plain file - $size bytes\n"); $self->_copyPlainFile($src_path, $dst_path) or return undef; $self->_fixOwnerPermissionsTimestamp($dst_path); } elsif (-d _) { # directory $self->debugPrint(9, "$src_path is a directory\n"); return undef unless mkdir $dst_path, 0777; $self->_fixOwnerPermissionsTimestamp($dst_path); } elsif (-p _) { # don't copy pipes, sockets, and other special files for now # named pipe $self->debugPrint(9, "$src_path is a named pipe\n"); } elsif (-S _) { # socket $self->debugPrint(9, "$src_path is a socket\n"); } elsif (-b _) { # block special file $self->debugPrint(9, "$src_path is a block special file\n"); } elsif (-c _) { # character special file $self->debugPrint(9,"$src_path is a character special file\n"); } $self->debugPrint(9, sprintf("$src_path has permissions %o\n", $permissions)); return 1; } sub _isSameFile { my ($self, $src_file, $dst_file) = @_; my ($src_dev, $src_ino); my ($dst_dev, $dst_ino); if (-l $src_file or -l $dst_file) { ($src_dev, $src_ino) = (lstat($src_file))[0,1]; ($dst_dev, $dst_ino) = (lstat($dst_file))[0,1]; } else { ($src_dev, $src_ino) = (stat($src_file))[0,1]; ($dst_dev, $dst_ino) = (stat($dst_file))[0,1]; } if ($src_dev == $dst_dev and $src_ino == $dst_ino) { return 1; } return 0; } sub _fixOwnerPermissionsTimestamp { my ($self, $dst_file) = @_; my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat(_); my $permissions = $mode & 07777; chown $uid, $gid, $dst_file; chmod $permissions, $dst_file; utime $atime, $mtime, $dst_file; } sub _copyPlainFile { my ($self, $src_path, $dst_path) = @_; local(*IN); local(*OUT); open(IN, '<' . $src_path) or return undef; unless (open(OUT, '>' . $dst_path)) { close IN; return undef; } # just in case this ever runs on windoze binmode IN, ':raw'; binmode OUT, ':raw'; my $buf; while (read(IN, $buf, 1024)) { print OUT $buf; } close IN; close OUT; return 1; } sub remove { my ($self, $victim) = @_; $self->debugPrint(9, "remove() - passed $victim\n"); if (not -l $victim and -d $victim) { return $self->_removeDirectoryRecursive($victim); } else { $self->debugPrint(1, "Removing $victim\n"); my $params = $self->_getParams; if ($$params{use_flock}) { local(*FILE); open(FILE, '+<' . $victim); unless (CORE::flock(FILE, &Fcntl::LOCK_EX() | &Fcntl::LOCK_NB)) { # can't get lock close FILE; $self->debugPrint(1, "Could not get lock on $victim -- not removing\n"); return undef; } my $rv = unlink $victim; CORE::flock(FILE, &Fcntl::LOCK_UN); close FILE; if (not $rv and $$params{use_rm}) { # added for v0.08 $self->debugPrint(1, "unlink() failed -- using /bin/rm\n"); $rv = not system("/bin/rm", "-f", $victim); } return $rv; } else { my $rv = unlink $victim; if (not $rv and $$params{use_rm}) { # added for v0.08 $self->debugPrint(1, "unlink() failed -- using /bin/rm\n"); $rv = not system("/bin/rm", "-f", $victim); } return $rv; } } } sub _removeDirectoryRecursive { my ($self, $dir) = @_; $self->debugPrint(9, "_removeDirectoryRecursive() - passed $dir\n"); local(*DIR); my $cur_dir = File::Spec->curdir; my $parent_dir = File::Spec->updir; opendir(DIR, $dir) or return undef; my @files = grep { $_ ne $cur_dir and $_ ne $parent_dir } readdir DIR; closedir DIR; my ($vol, $dirs, $dir_file) = File::Spec->splitpath($dir); foreach my $file (@files) { my $victim_dir = File::Spec->catdir($dirs, $dir_file); my $victim_path = File::Spec->catpath($vol, $victim_dir, $file); $self->debugPrint(9, "Trying to remove $victim_path\n"); $self->remove($victim_path); } $self->debugPrint(1, "Removing directory $dir\n"); rmdir $dir; return 1; } sub move { my ($self, $src, $dst) = @_; # FIXME: implement } # expects full path for $src and $dst sub _move { my ($self, $src, $dst) = @_; # HERE my ($src_dev, $src_ino); my ($dst_dev, $dst_ino); if (-l $src or -l $dst) { ($src_dev, $src_ino) = (lstat($src))[0,1]; ($dst_dev, $dst_ino) = (lstat($dst))[0,1]; } else { ($src_dev, $src_ino) = (stat($src))[0,1]; ($dst_dev, $dst_ino) = (stat($dst))[0,1]; } if ($src_dev == $dst_dev) { # same filesystem, so we can just do a rename rename $src, $dst; } else { # HERE } } sub debugOn { my ($self, $fh, $level) = @_; $$self{_debug} = 1; $$self{_debug_level} = $level; $$self{_debug_fh} = $fh; } sub debugOff { my ($self) = @_; undef $$self{_debug}; undef $$self{_debug_fh}; } sub debugPrint { my ($self, $level, $str) = @_; return undef unless $$self{_debug}; return undef unless $$self{_debug_level} >= $level; my $fh = $$self{_debug_fh}; print $fh $str; } sub _getParams { my ($self) = @_; return $$self{_params} || {}; } } 1; __END__ =pod =head1 NAME File::Rotate::Backup::Copy - =head1 SYNOPSIS =head1 DESCRIPTION =head1 METHODS =head1 EXAMPLES =head1 BUGS =head1 AUTHOR =head1 VERSION $Id: Copy.pm,v 1.10 2004/03/21 04:56:19 don Exp $ =cut File-Rotate-Backup-0.13/lib/File/Rotate/Backup.pm0000644000076500007650000004611210730375172017546 0ustar dondon# -*-perl-*- # Creation date: 2003-03-09 15:38:36 # Authors: Don # Change log: # $Id: Backup.pm,v 1.33 2007/12/14 03:37:30 don Exp $ # # Copyright (c) 2003-2007 Don Owens. All rights reserved. # # This is free software; you can redistribute it and/or modify it under # the Perl Artistic license. You should have received a copy of the # Artistic license with this distribution, in the file named # "Artistic". You may also obtain a copy from # http://regexguy.com/license/Artistic # # This program is distributed in the hope that it will be # useful, but WITHOUT ANY WARRANTY; without even the implied # warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR # PURPOSE. =pod =head1 NAME File::Rotate::Backup - Make backups of multiple directories and rotate them on unix. =head1 SYNOPSIS my $params = { archive_copies => 2, dir_copies => 1, backup_dir => '/backups', file_prefix => 'backup_' secondary_backup_dir => '/backups2', secondary_archive_copies => 2, verbose => 1, use_flock => 1, }; my $backup = File::Rotate::Backup->new($params); $backup->backup([ [ '/etc/httpd/conf' => 'httpd_conf' ], [ '/var/named' => 'named' ], ]); $backup->rotate; =head1 DESCRIPTION This module will make backups and rotate them according to your specification. It creates a backup directory based on the file_prefix you specify and the current time. It then copies the directories you specified in the call to new() to that backup directory. Then a tar'd and compressed file is created from that directory. By default, bzip2 is used for compression. This module has only been tested on Linux and Solaris. The only external programs used are tar and a compression program. Copies and deletes are implemented internally. =head1 METHODS =cut use strict; use File::Find (); # use File::Copy (); { package File::Rotate::Backup; use vars qw($VERSION); BEGIN { $VERSION = '0.13'; # update below in POD as well } use File::Rotate::Backup::Copy; =pod =head2 new(\%params) my $params = { archive_copies => 2, dir_copies => 1, backup_dir => '/backups', file_prefix => 'backup_' secondary_backup_dir => '/backups2', secondary_archive_copies => 2, verbose => 1, use_flock => 1, dir_regex => '\d+-\d+-\d+_\d+_\d+_\d+', file_regex => '\d+-\d+-\d+_\d+_\d+_\d+', }; my $backup = File::Rotate::Backup->new($params); Creates a backup object. =over 4 =item archive_copies The number of old archive files to keep. =item no_archive If set to true, then no compressed archive(s) will be created even if archive_copies is set. =item dir_copies The number of old backup directories to keep. =item backup_dir Where backups are placed. =item file_prefix The prefix to use for the backup directories and archive files. When the directories and archive files are created, the name for each is created by appending a timestamp to the end of the file prefix you specify. =item secondary_backup_dir Overflow directory to copy files to before deleting them from the backup directory when rotating. =item secondary_archive_copies The number of archive files to keep in the secondary backup directory. =item verbose If set to a true value, status messages will be printed as the files are being processed. =item use_flock If set to a true value, an attempt will be made to acquire a write lock on any file to be removed during rotation. If a lock cannot be acquired, the file will not be removed. This is useful for concurrency control, e.g., when your backup script gets run at the same time as another script that is writing the backups to tape. =item use_rm If set to a true value, the external program /bin/rm will be used to remove a file in the case where unlink() fails. This may occur on systems where the file being removed is larger than 2GB and such files are not fully supported. =item dir_regex Regular expression used to search for directories to rotate. The file_prefix is prepended to this to create the final regular expression. This is useful for rotating directories that were not created by this module. =item file_regex Regular expression used to search for archive files to rotate. The file_prefix is prepended to this to create the final regular expression. This is useful for rotating files that were not created by this module. =back =cut # BEGIN { # use vars '%Config'; # eval 'use Config'; # } sub new { my ($proto, $params) = @_; my $self = {}; bless $self, ref($proto) || $proto; $self->setArchiveCopies(defined($$params{archive_copies}) ? $$params{archive_copies} : 1); $self->setDirCopies(defined($$params{dir_copies}) ? $$params{dir_copies} : 1); my $dir = $$params{backup_dir}; $dir = '/tmp' if $dir eq ''; $self->setBackupDir($dir); $self->setSecondaryBackupDir($$params{secondary_backup_dir}); $self->setSecondaryArchiveCopies($$params{secondary_archive_copies}); $self->setFilePrefix($$params{file_prefix}); $self->_setVerbose($$params{verbose}); $self->_setUseFileLock($$params{use_flock}); $self->_setUseRm($$params{use_rm}); $self->{_archive_dir_regex} = $params->{dir_regex} if defined $params->{dir_regex}; $self->{_archive_file_regex} = $params->{file_regex} if defined $params->{file_regex}; $self->{_no_archive} = defined $params->{no_archive} ? $params->{no_archive} : 0; # foreach my $exe ('tar', 'gzip', 'bzip2', 'rm', 'mv') { # if (defined($Config{$exe}) and $Config{$exe} ne '') { # $self->{'_' . $exe} = $Config{$exe}; # } # } return $self; } =pod =head2 backup(\@conf) Makes the backup -- creates the backed up directory and archive file. @conf is an array where each element is either a string or an array. If it is a string, it is expected to be the path to a directory that is to be backed up. If the element is an array, the first element is expected to be a directory that is to be backed up, and the second should be the name the directory is called once it has been copied to the backup directory. The return value is the name of the archive file created; unless 'no_archive' is set, then it will return an empty string. =cut sub backup { my ($self, $conf) = @_; my $today = $self->_getTimestampForFileName; my $file_prefix = $self->getFilePrefix . $today; my $backup_dir = $self->getBackupDir; my $dst = "$backup_dir/$file_prefix"; my $dst_file = ''; mkdir $dst, 0755; my $cp = $self->getCpPath; foreach my $entry (@$conf) { if (ref($entry) eq 'ARRAY') { my ($dir, $name) = @$entry; $self->copy($dir, "$dst/$name"); } else { $self->copy($entry, "$dst/"); } } unless ( $self->{_no_archive} ) { my $compress = $self->getCompressProgramPath; my $ext = $self->getCompressExtension; $ext = '.' . $ext unless $ext eq ''; $dst_file = $dst . '.tar' . $ext; my $params = '-p'; $params = '-v ' . $params if $self->_getVerbose; my $tar_cmd = $self->getTarPath . " $params -c -f - -C '$backup_dir' '$file_prefix'"; system "$tar_cmd | $compress > $dst_file"; } return $dst_file; } =pod =head2 rotate() Rotates the backup directories and archive files. The number of archive files to keep and the number of directories to keep are specified in the new() constructor. =cut sub rotate { my ($self) = @_; my $archive_copies = $self->getArchiveCopies; my $dir_copies = $self->getDirCopies; my $backup_dir = $self->getBackupDir; my $secondary_backup_dir = $self->getSecondaryBackupDir; $self->_rotate($backup_dir, $archive_copies, $dir_copies, $secondary_backup_dir); return 1 if $secondary_backup_dir eq ''; my $secondary_archive_copies = $self->getSecondaryArchiveCopies; $self->_rotate($secondary_backup_dir, $secondary_archive_copies, 0, ''); } =pod =head2 my $archives = getArchiveDeleteList() Returns a list of archive files that will get deleted if the rotate() method is called. =cut sub getArchiveDeleteList { my ($self) = @_; my $backup_dir = $self->getBackupDir; my $archives = $self->_getSortedArchives($backup_dir); my $num_archives = scalar(@$archives); my $archive_copies = $self->getArchiveCopies; my @files_to_delete; if ($num_archives > $archive_copies) { my $num_to_delete = $num_archives - $archive_copies; @files_to_delete = @$archives[0 .. $num_to_delete - 1]; } @files_to_delete = map { "$backup_dir/$_" } @files_to_delete; return \@files_to_delete; } =pod =head2 my $dirs = getDirDeleteList() Returns a list of directories that will get deleted if the rotate() method is called. =cut sub getDirDeleteList { my ($self) = @_; my $backup_dir = $self->getBackupDir; my $dirs = $self->_getSortedArchiveDirs($backup_dir); my $num_dirs = scalar(@$dirs); my $dir_copies = $self->getDirCopies; my @dirs_to_delete; if ($num_dirs > $dir_copies) { my $num_to_delete = $num_dirs - $dir_copies; @dirs_to_delete = @$dirs[0 .. $num_to_delete - 1]; } @dirs_to_delete = map { "$backup_dir/$_" } @dirs_to_delete; return \@dirs_to_delete; } sub _rotate { my ($self, $backup_dir, $archive_copies, $dir_copies, $secondary_backup_dir) = @_; my $archives = $self->_getSortedArchives($backup_dir); my $num_archives = scalar(@$archives); my $dirs = $self->_getSortedArchiveDirs($backup_dir); my $num_dirs = scalar(@$dirs); if ($num_archives > $archive_copies) { my $num_to_delete = $num_archives - $archive_copies; my @files_to_delete = @$archives[0 .. $num_to_delete - 1]; foreach my $file (@files_to_delete) { my $path = "$backup_dir/$file"; unless ($secondary_backup_dir eq '') { $self->copy($path, "$secondary_backup_dir/"); } $self->_debugPrint("removing $path\n"); $self->remove($path); } } if ($num_dirs > $dir_copies) { my $num_to_delete = $num_dirs - $dir_copies; my @dirs_to_delete = @$dirs[0 .. $num_to_delete - 1]; foreach my $dir (@dirs_to_delete) { my $path = "$backup_dir/$dir"; $self->_debugPrint("removing $path\n"); $self->remove($path); } } } sub _debug { my ($self) = @_; return $$self{_debug}; } sub _debugOff { my ($self) = @_; undef $$self{_debug}; undef $$self{_debug_fh}; } sub _debugOn { my ($self, $fh) = @_; $$self{_debug} = 1; $$self{_debug_fh} = $fh; } sub _debugPrint { my ($self, $str) = @_; return undef unless $$self{_debug}; my $fh = $$self{_debug_fh}; print $fh $str; } sub _getVerbose { my ($self) = @_; return $$self{_verbose}; } sub _setVerbose { my ($self, $val) = @_; return $$self{_verbose} = $val; } sub _getUseFileLock { my ($self) = @_; return $$self{_use_flock}; } sub _setUseFileLock { my ($self, $val) = @_; $$self{_use_flock} = $val; } sub _getUseRm { my ($self) = @_; return $$self{_use_rm}; } sub _setUseRm { my ($self, $val) = @_; $$self{_use_rm} = $val; } sub copy { my ($self, $src, $dst) = @_; my $copy = $self->_getCopyObject; $copy->copy($src, $dst); } sub _getCopyObject { my ($self) = @_; my $copy = $$self{_copy_obj}; unless ($copy) { $copy = File::Rotate::Backup::Copy->new({ use_flock => $self->_getUseFileLock, use_rm => $self->_getUseRm }); $$self{_copy_obj} = $copy; } if ($$self{_debug}) { $copy->debugOn($$self{_debug_fh}, 1); } elsif ($self->_getVerbose) { $copy->debugOn(\*STDERR, 1); } else { $copy->debugOff; } return $copy; } sub remove { my ($self, $victim) = @_; my $remove = $self->_getCopyObject; $remove->remove($victim); } sub _getArchiveFileRegex { my $self = shift; my $prefix = quotemeta($self->getFilePrefix); my $regex; if (exists($self->{_archive_file_regex})) { $regex = $self->{_archive_file_regex}; } else { $regex = '\d+-\d+-\d+_\d+_\d+_\d+'; } $regex = $prefix . $regex; return $regex; } sub _getSortedArchives { my ($self, $dir) = @_; # my $prefix = quotemeta($self->getFilePrefix); $dir = $self->getBackupDir if $dir eq ''; local(*DIR); opendir(DIR, $dir) or return undef; my $regex = $self->_getArchiveFileRegex; my @files = grep { m/^$regex/ and not -d "$dir/$_" } readdir DIR; closedir DIR; @files = sort { $a cmp $b } @files; return \@files; } sub _getArchiveDirRegex { my $self = shift; my $prefix = quotemeta($self->getFilePrefix); my $regex; if (exists($self->{_archive_dir_regex})) { $regex = $self->{_archive_dir_regex}; $regex = '' unless defined $regex; } else { $regex = '\d+-\d+-\d+_\d+_\d+_\d+'; } $regex = $prefix . $regex; return $regex; } sub _getSortedArchiveDirs { my ($self, $dir) = @_; # my $prefix = quotemeta($self->getFilePrefix); $dir = $self->getBackupDir if $dir eq ''; local(*DIR); opendir(DIR, $dir) or return undef; # my @files = grep { m/^$prefix\d+-\d+-\d+_\d+_\d+_\d+/ and -d "$dir/$_" } readdir DIR;' my $regex = $self->_getArchiveDirRegex; my @files = grep { m/^$regex/ and -d "$dir/$_" } readdir DIR; closedir DIR; @files = sort { $a cmp $b } @files; return \@files; } sub _getTimestampForFileName { my ($self, $time) = @_; $time = time() unless $time; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time); $mon += 1; $year += 1900; my $date = sprintf "%04d-%02d-%02d_%02d_%02d_%02d", $year, $mon, $mday, $hour, $min, $sec; return $date; } ################# # getters/setters sub getCompressProgramPath { my ($self) = @_; my $path = $$self{_compress_program_path}; if ($path eq '') { return $self->{_bzip2_path} || 'bzip2'; } return $path; } =pod =head2 setCompressProgramPath($path) Set the path to the compression program you want to use when creating the archive files in the call to backup(). The given compression program must provide the same API as gzip and bzip2, at least to the extent that it will except input from stdin and will write output to stdout when no file names are provided. This defaults to 'bzip2' (no explicit path). =cut sub setCompressProgramPath { my ($self, $path) = @_; $$self{_compress_program_path} = $path; } sub getCompressExtension { my ($self) = @_; if (exists($$self{_compress_ext})) { return $$self{_compress_ext}; } my $compress_prog_path = $self->getCompressProgramPath; my $prog; if ($compress_prog_path =~ m{(?:\A|/)([^/\s]+)([^/]*)$}) { $prog = $1; } my $ext = { 'bzip2' => 'bz2', 'gzip' => 'gz', }->{$prog}; return $ext; } =pod =head2 setCompressExtension($ext) This sets the extension given to the archive name after the .tar. This defaults to .bz2 if bzip2 is used for compression, and .gz if gzip is used. =cut sub setCompressExtension { my ($self, $ext) = @_; $ext =~ s/^\.// unless $ext eq '.'; $$self{_compress_ext} = $ext; } sub getTarPath { my ($self) = @_; my $path = $$self{_tar_path}; if ($path eq '') { return 'tar'; } return $path; } =pod =head2 setTarPath($path) Set the path to the tar program. This defaults to 'tar' (no explicit path). =cut sub setTarPath { my ($self, $path) = @_; $$self{_tar_path} = $path; } sub getRmPath { my ($self) = @_; my $path = $$self{_rm_path}; if ($path eq '') { return '/bin/rm'; } return $path; } sub setRmPath { my ($self, $path) = @_; $$self{_rm_path} = $path; } sub getCpPath { my ($self) = @_; my $path = $$self{_cp_path}; if ($path eq '') { return 'cp'; } return $path; } sub setCpPath { my ($self, $path) = @_; $$self{_cp_path} = $path; } sub getArchiveCopies { my ($self) = @_; return $$self{_archive_copies}; } sub setArchiveCopies { my ($self, $num) = @_; $$self{_archive_copies} = $num; } sub getDirCopies { my ($self) = @_; return $$self{_dir_copies}; } sub setDirCopies { my ($self, $num) = @_; $$self{_dir_copies} = $num; } sub getBackupDir { my ($self) = @_; return $$self{_backup_dir}; } sub setBackupDir { my ($self, $dir) = @_; $$self{_backup_dir} = $dir; } # added for v0_02 sub getSecondaryBackupDir { my ($self) = @_; return $$self{_secondary_backup_dir}; } # added for v0_02 sub setSecondaryBackupDir { my ($self, $dir) = @_; $$self{_secondary_backup_dir} = $dir; } sub getSecondaryArchiveCopies { my ($self) = @_; return $$self{_secondary_archive_copies}; } sub setSecondaryArchiveCopies { my ($self, $num) = @_; $$self{_secondary_archive_copies} = $num; } sub getFilePrefix { my ($self) = @_; return $$self{_file_prefix}; } sub setFilePrefix { my ($self, $prefix) = @_; $$self{_file_prefix} = $prefix; } } 1; __END__ =pod =head1 AUTHOR Don Owens =head1 CONTRIBUTORS Augie Schwer =head1 COPYRIGHT Copyright (c) 2003-2007 Don Owens All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 VERSION 0.13 =cut File-Rotate-Backup-0.13/Makefile.PL0000755000076500007650000000164310716474602015077 0ustar dondon#!/usr/bin/env perl # Creation date: 2003-04-06 13:26:22 # Authors: Don # Change log: # $Id: Makefile.PL,v 1.9 2007/11/14 04:28:50 don Exp $ use strict; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'File::Rotate::Backup', DISTNAME => 'File-Rotate-Backup', VERSION_FROM => 'lib/File/Rotate/Backup.pm', ABSTRACT => 'Performs system backups and rotates them', AUTHOR => 'Don Owens ', PM => { 'lib/File/Rotate/Backup.pm' => '$(INST_LIBDIR)/Backup.pm', 'lib/File/Rotate/Backup/Copy.pm' => '$(INST_LIBDIR)/Backup/Copy.pm', }, PREREQ_PM => { 'File::Spec' => 0, 'Fcntl' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz' }, DIR => [], EXE_FILES => [], ); File-Rotate-Backup-0.13/MANIFEST0000644000076500007650000000031010716470517014242 0ustar dondonMANIFEST Makefile.PL WhatsNew lib/File/Rotate/Backup.pm lib/File/Rotate/Backup/Copy.pm t/00use.t README INSTALL Artistic META.yml Module meta-data (added by MakeMaker) File-Rotate-Backup-0.13/META.yml0000644000076500007650000000073410730375230014364 0ustar dondon--- #YAML:1.0 name: File-Rotate-Backup version: 0.13 abstract: Performs system backups and rotates them license: ~ generated_by: ExtUtils::MakeMaker version 6.36 distribution_type: module requires: Fcntl: 0 File::Spec: 0 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 author: - Don Owens File-Rotate-Backup-0.13/README0000644000076500007650000001402710730375225013777 0ustar dondonNAME File::Rotate::Backup - Make backups of multiple directories and rotate them on unix. SYNOPSIS my $params = { archive_copies => 2, dir_copies => 1, backup_dir => '/backups', file_prefix => 'backup_' secondary_backup_dir => '/backups2', secondary_archive_copies => 2, verbose => 1, use_flock => 1, }; my $backup = File::Rotate::Backup->new($params); $backup->backup([ [ '/etc/httpd/conf' => 'httpd_conf' ], [ '/var/named' => 'named' ], ]); $backup->rotate; DESCRIPTION This module will make backups and rotate them according to your specification. It creates a backup directory based on the file_prefix you specify and the current time. It then copies the directories you specified in the call to new() to that backup directory. Then a tar'd and compressed file is created from that directory. By default, bzip2 is used for compression. This module has only been tested on Linux and Solaris. The only external programs used are tar and a compression program. Copies and deletes are implemented internally. METHODS new(\%params) my $params = { archive_copies => 2, dir_copies => 1, backup_dir => '/backups', file_prefix => 'backup_' secondary_backup_dir => '/backups2', secondary_archive_copies => 2, verbose => 1, use_flock => 1, dir_regex => '\d+-\d+-\d+_\d+_\d+_\d+', file_regex => '\d+-\d+-\d+_\d+_\d+_\d+', }; my $backup = File::Rotate::Backup->new($params); Creates a backup object. archive_copies The number of old archive files to keep. no_archive If set to true, then no compressed archive(s) will be created even if archive_copies is set. dir_copies The number of old backup directories to keep. backup_dir Where backups are placed. file_prefix The prefix to use for the backup directories and archive files. When the directories and archive files are created, the name for each is created by appending a timestamp to the end of the file prefix you specify. secondary_backup_dir Overflow directory to copy files to before deleting them from the backup directory when rotating. secondary_archive_copies The number of archive files to keep in the secondary backup directory. verbose If set to a true value, status messages will be printed as the files are being processed. use_flock If set to a true value, an attempt will be made to acquire a write lock on any file to be removed during rotation. If a lock cannot be acquired, the file will not be removed. This is useful for concurrency control, e.g., when your backup script gets run at the same time as another script that is writing the backups to tape. use_rm If set to a true value, the external program /bin/rm will be used to remove a file in the case where unlink() fails. This may occur on systems where the file being removed is larger than 2GB and such files are not fully supported. dir_regex Regular expression used to search for directories to rotate. The file_prefix is prepended to this to create the final regular expression. This is useful for rotating directories that were not created by this module. file_regex Regular expression used to search for archive files to rotate. The file_prefix is prepended to this to create the final regular expression. This is useful for rotating files that were not created by this module. backup(\@conf) Makes the backup -- creates the backed up directory and archive file. @conf is an array where each element is either a string or an array. If it is a string, it is expected to be the path to a directory that is to be backed up. If the element is an array, the first element is expected to be a directory that is to be backed up, and the second should be the name the directory is called once it has been copied to the backup directory. The return value is the name of the archive file created; unless 'no_archive' is set, then it will return an empty string. rotate() Rotates the backup directories and archive files. The number of archive files to keep and the number of directories to keep are specified in the new() constructor. my $archives = getArchiveDeleteList() Returns a list of archive files that will get deleted if the rotate() method is called. my $dirs = getDirDeleteList() Returns a list of directories that will get deleted if the rotate() method is called. setCompressProgramPath($path) Set the path to the compression program you want to use when creating the archive files in the call to backup(). The given compression program must provide the same API as gzip and bzip2, at least to the extent that it will except input from stdin and will write output to stdout when no file names are provided. This defaults to 'bzip2' (no explicit path). setCompressExtension($ext) This sets the extension given to the archive name after the .tar. This defaults to .bz2 if bzip2 is used for compression, and .gz if gzip is used. setTarPath($path) Set the path to the tar program. This defaults to 'tar' (no explicit path). AUTHOR Don Owens CONTRIBUTORS Augie Schwer COPYRIGHT Copyright (c) 2003-2007 Don Owens All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. VERSION 0.13 File-Rotate-Backup-0.13/t/0000755000076500007650000000000010730375230013352 5ustar dondonFile-Rotate-Backup-0.13/t/00use.t0000755000076500007650000000055707644176230014516 0ustar dondon#!/usr/bin/perl # Creation date: 2003-04-06 11:36:54 # Authors: Don # Change log: # $Id: 00use.t,v 1.2 2003/04/07 04:20:40 don Exp $ use strict; # main { use strict; use Test; BEGIN { plan tests => 1 } use File::Rotate::Backup; ok(1); } exit 0; ############################################################################### # Subroutines File-Rotate-Backup-0.13/WhatsNew0000644000076500007650000000041610716470221014573 0ustar dondonVersion 0.11 * added no_archive option Version 0.09 * ability to configure regular expressions for the archive files and directories in the case where you only use the rotate() method, e.g., on directories or files not created by this module *