File Coverage

blib/lib/App/BackupPlan.pm

Criterion	Covered	Total	%
statement	25	94	26.6
branch	0	38	0.0
condition	0	3	0.0
subroutine	9	26	34.6
pod			n/a
total	34	161	21.1

package App::BackupPlan::Policy;

use Archive::Tar;
use File::Find;

sub new {
	my $class = shift;
	my $self = {
		maxFiles  => shift,
		prefix    => shift,
		frequency => shift,
		targetDir => shift,
		sourceDir => shift};

	bless $self,$class;
	return $self;
}

sub setMaxFiles {
    my ( $self, $maxFiles ) = @_;
    $self->{maxFiles} = $maxFiles if defined($maxFiles);
    return $self->{maxFiles};
}

sub getMaxFiles {
    my( $self ) = @_;
    return $self->{maxFiles};
}

sub setPrefix {
    my ( $self, $prefix ) = @_;
    $self->{prefix} = $prefix if defined($prefix);
    return $self->{prefix};
}

sub getPrefix {
    my( $self ) = @_;
    return $self->{prefix};
}

sub setFrequency {
    my ( $self, $frequency ) = @_;
    $self->{frequency} = $frequency if defined($frequency);
    return $self->{frequency};
}

sub getFrequency {
    my( $self ) = @_;
    return $self->{frequency};
}

sub setTargetDir {
    my ( $self, $targetDir ) = @_;
    $self->{targetDir} = $targetDir if defined($targetDir);
    return $self->{targetDir};
}

sub getTargetDir {
    my( $self ) = @_;
    return $self->{targetDir};
}

sub setSourceDir {
    my ( $self, $sourceDir ) = @_;
    $self->{sourceDir} = $sourceDir if defined($sourceDir);
    return $self->{sourceDir};
}

sub getSourceDir {
    my( $self ) = @_;
    return $self->{sourceDir};
}

sub set {
	my ($self, $name, $value) = @_;
	$self->{$name} = $value if defined($value) && defined($name);
}

sub print {
	my( $self ) = @_;
	$self->{maxFiles} = "n/a" unless defined($self->{maxFiles});
	$self->{prefix} = "n/a" unless defined($self->{prefix});
	$self->{frequency} = "n/a" unless defined($self->{frequency});
	$self->{targetDir} = "n/a" unless defined($self->{targetDir});
	$self->{sourceDir} = "n/a" unless defined($self->{sourceDir});
	print "Policy: maxFiles=$self->{maxFiles},
	prefix=$self->{prefix},
	frequency=$self->{frequency},
	targetDir=$self->{targetDir},
	sourceDir=$self->{sourceDir}\n";
}

sub info {
	my( $self ) = @_;
	$self->{maxFiles} = "n/a" unless defined($self->{maxFiles});
	$self->{prefix} = "n/a" unless defined($self->{prefix});
	$self->{frequency} = "n/a" unless defined($self->{frequency});
	$self->{targetDir} = "n/a" unless defined($self->{targetDir});
	$self->{sourceDir} = "n/a" unless defined($self->{sourceDir});
	return "Policy: maxFiles=$self->{maxFiles},
	prefix=$self->{prefix},
	frequency=$self->{frequency},
	targetDir=$self->{targetDir},
	sourceDir=$self->{sourceDir}";
}

sub tar {
	my( $self, $ts, $hasExcludeTag ) = @_;
	my $filename = sprintf("%s/%s_%s.tar.gz",$self->{targetDir},$self->{prefix},$ts);
	my $option = '';
	$option = '--exclude-tag-all=NOTAR' if $hasExcludeTag;
	my $output = `tar cvzf $filename $option $self->{sourceDir} 2>&1 1>/dev/null`;
	if (-e $filename) {
		my $stat = `ls -lh $filename`;
		return "system tar: $stat";
	}
	return "Error: tar failed to produce $filename\n$output\n";
}

sub perlTar {
	my( $self, $ts ) = @_;
	my $filename = sprintf("%s/%s_%s.tar.gz",$self->{targetDir},$self->{prefix},$ts);
	my $tar = new Archive::Tar;
	our @files=();
	find(sub {push(@files,$File::Find::name);},$self->{sourceDir});
	$tar->add_files(@files);
	$tar->write($filename,COMPRESS_GZIP);
	if (-e $filename) {
		my $stat = `ls -lh $filename`;
		return "perl tar: $stat";
	}
	my $err = $tar->error();
	return "Error: tar failed to produce $filename\n$err\n";
}


package App::BackupPlan;

use 5.012003;
use strict;
use warnings;
use Config;
use DateTime;
use Time::Local;
use XML::DOM;
use Log::Log4perl qw(:easy);

require XML::DOM;
require Log::Log4perl;

require Exporter;
use AutoLoader qw(AUTOLOAD);

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use App::BackupPlan ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw();


BEGIN {
	our $VERSION = '0.0.7';
	print "App::BackupPlan by Gualtiero Chiaia, version $VERSION\n";
}

# Preloaded methods go here.

our $TAR = 'system'; #use system tar
our $HAS_EXCLUDE_TAG = 0; #has tar option --exclude-tag

sub new {
	my $class = shift;
	my $self = {
		config => shift,
		log => shift
	};

	bless $self,$class;
	return $self;
}

sub run {
	my ($self) = @_;

	#validate the config file
	die "App::BackupPlan configuration file is required, but was not given!" unless defined $self->{config};

	#logging config
	if (defined $self->{log}) {
		Log::Log4perl::init($self->{log});
	} else {
        Log::Log4perl->easy_init( { level   => $INFO,
                                    file    => ">>easy.log" } );
	}

	my $logger = Log::Log4perl::get_logger();

	#get the environment
	&getEnvironment;

	#--now read config file
	my $parser = new XML::DOM::Parser;
	my $doc = $parser->parsefile ($self->{config}) or die "Could not parse $self->{config}";

	#get policies
	my ($obj,%policies) = &getPolicies($doc);
	foreach my $k (keys %policies) {
		#policy info
		print "**$k policy**\n";
		$logger->info("**$k policy**");

		my $policy = $policies{$k};
		$policy->print;
		$logger->debug($policy->info);
		my $now = time;
		my $ts = &formatTimeSpan(time);
		my %files = &getFiles($policy->getTargetDir,$policy->getPrefix);
		#get last
		my $lastts = &getLastTs(keys %files);
		my $threshold = &subTimeSpan($now,$policy->getFrequency);
		if (!defined($lastts) || $lastts < $threshold ) { #needs a new tar file
			my $lastTS = '';
			$lastTS = &formatTimeSpan($lastts) if defined $lastts;
			$logger->info("Need a new tar file, last tar was on $lastTS");
			my $tarout;
			if (lc $TAR eq 'perl') {$tarout= $policy->perlTar($ts);}
			else {$tarout = $policy->tar($ts,$HAS_EXCLUDE_TAG);}
			if ($tarout =~ /Error/i) {
				$logger->error($tarout);
			} else {
				$logger->debug($tarout);
			}

			#now delete old
			%files = &getFiles($policy->getTargetDir,$policy->getPrefix);
			my $maxFiles = $policy->getMaxFiles;
			my $cnt = scalar(keys %files);
			while ($cnt > $maxFiles && $cnt >0) {
				my $oldts = &getFirstTs(keys %files);
				my $oldTS = '';
				$oldTS = &formatTimeSpan($oldts) if defined $oldts;
				unlink $files{$oldts};
				$logger->info("Deleted old tar file, with time stamp $oldTS");
				%files = &getFiles($policy->getTargetDir,$policy->getPrefix);
				$cnt--;
			} #end while
		} #end if
	} #end foreach
} #end sub

sub getEnvironment {
	my $env = $Config{osname};
	if 	($Config{osname} =~ /linux/i) {
		my $output = `man tar | grep /\-\-exclude\-tag/ | wc -l`;
		$HAS_EXCLUDE_TAG = 1 unless ($output eq '0');
	} else {$TAR = 'perl';}

}


sub getPolicies {
	my $xml = $_[0];
	my $defaultPolicy = new App::BackupPlan::Policy;
	#get default policy first
	#first default policy
	my $nodes = $xml->getElementsByTagName("default");
	if ($nodes->getLength > 0) {
		my $node = $nodes->item(0);
		foreach my $child ($node->getChildNodes) {
			if ($child->getNodeType == ELEMENT_NODE){
				my $name = $child->getNodeName;
				my $value = $child->getFirstChild->getNodeValue;
				$defaultPolicy->set($name,$value);
			}
		}
	}
	#then all policies
	my %raw_policies;
	$nodes = $xml->getElementsByTagName("task");
	for (my $i=0;$i<$nodes->getLength; $i++) {
		my $task = $nodes->item($i);
		my $taskName = $task->getAttributes->getNamedItem('name')->getNodeValue;
		my $p = new App::BackupPlan::Policy;
		foreach my $child ($task->getChildNodes) {
			if ($child->getNodeType == ELEMENT_NODE){
				my $name = $child->getNodeName;
				my $value = $child->getFirstChild->getNodeValue;
				$p->set($name,$value);
			}
		}
		$raw_policies{$taskName} = $p;
	}
	%raw_policies = injectDefaultPolicy($defaultPolicy,%raw_policies);
	return ($defaultPolicy,%raw_policies);
}

sub injectDefaultPolicy {
	my ($defPolicy,%raw_pcs) = @_;
	foreach my $k (keys %raw_pcs) {
		$raw_pcs{$k}->setMaxFiles($defPolicy->getMaxFiles) unless defined($raw_pcs{$k}->getMaxFiles);
		$raw_pcs{$k}->setPrefix($defPolicy->getPrefix) unless defined($raw_pcs{$k}->getPrefix);
		$raw_pcs{$k}->setFrequency($defPolicy->getFrequency) unless defined($raw_pcs{$k}->getFrequency);
		$raw_pcs{$k}->setSourceDir($defPolicy->getSourceDir) unless defined($raw_pcs{$k}->getSourceDir);
		$raw_pcs{$k}->setTargetDir($defPolicy->getTargetDir) unless defined($raw_pcs{$k}->getTargetDir);
	}
	return %raw_pcs;
}

sub addTimeSpan{
	my ($timestamp,$span) = @_;
	my @ts = localtime $timestamp;
	my $year = $ts[5]+1900;
	my $month = $ts[4]+1;
	my $day = $ts[3];
	my $dt = DateTime->new(year	=> $year, month	=> $month, day	=> $day);
	if ($span=~/(\d+)d/) {
		$dt->add_duration(DateTime::Duration->new(days => $1));
		return timelocal(0,0,0,$dt->day(),$dt->month()-1,$dt->year());
	}
	if ($span=~/(\d+)m/) {
		$dt->add_duration(DateTime::Duration->new(months => $1));
		return timelocal(0,0,0,$dt->day(),$dt->month()-1,$dt->year());
	}
	if ($span=~/(\d+)y/) {
		$dt->add_duration(DateTime::Duration->new(years => $1));
		return timelocal(0,0,0,$dt->day(),$dt->month()-1,$dt->year());
	}
}

sub subTimeSpan{
	my ($timestamp,$span) = @_;
	my @ts = localtime $timestamp;
	my $year = $ts[5]+1900;
	my $month = $ts[4]+1;
	my $day = $ts[3];
	my $dt = DateTime->new(year	=> $year, month	=> $month, day	=> $day,);
	if ($span=~/(\d+)d/) {
		$dt->subtract_duration(DateTime::Duration->new(days => $1));
		return timelocal(0,0,0,$dt->day(),$dt->month()-1,$dt->year());
	}
	if ($span=~/(\d+)m/) {
		$dt->subtract_duration(DateTime::Duration->new(months => $1));
		return timelocal(0,0,0,$dt->day(),$dt->month()-1,$dt->year());
	}
	if ($span=~/(\d+)y/) {
		$dt->subtract_duration(DateTime::Duration->new(years => $1));
		return timelocal(0,0,0,$dt->day(),$dt->month()-1,$dt->year());
	}
	return $timestamp;
}

sub formatTimeSpan {
	my $ts = $_[0];
	my @ts = localtime $ts;
	my $year = $ts[5]+1900;
	my $month = $ts[4]+1;
	my $day = $ts[3];
	return sprintf("%4d%02d%02d",$year,$month,$day);
}

sub getFiles {
	my %fileMap;
	my ($sourceDir, $pattern) = @_;
	opendir DH, $sourceDir or die "Cannot open directory $sourceDir: $!\n";
	foreach my $f (readdir DH) {
		if ($f=~/$pattern.*/) {
			my $fname = $sourceDir."/".$f;
			#print "$fname\n";
			my @s = stat $fname;
			my $mtime = $s[9];
			$fileMap{$mtime}= $fname;
		}
	}
	closedir DH;
	return %fileMap;
}

sub getLastTs {
	my (@ts) = sort @_;
	my $nts = scalar @ts;
	return $ts[$nts-1];
}

sub getFirstTs {
	my (@ts) = sort @_;
	return $ts[0];
}



# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__