view release on metacpan or  search on metacpan

lib/App/BackupPlan.pm  view on Meta::CPAN

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_policy {
    my ($policy,$now, $logger) = @_;
    $policy->print;
    $logger->debug($policy->info) if defined $logger;
    my $ts = &fromTS2ISO($now);
    my %files = &getFiles($policy->getTargetDir,$policy->getPrefix);
    #get last
    my $lastts = &getLastTs(keys %files);
    my $threshold = &fromTS2ISO(&subSpan($now,$policy->getFrequency));
    if (!defined($lastts) || $lastts < $threshold ) { #needs a new tar file
        if (defined $lastts) {
            $logger->info("Need a new tar file, last tar was on $lastts") if defined $logger;
        }
        else {
            $logger->info("Need a tar file") if defined $logger;
        }
        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) if defined $logger;	
        } else {
            $logger->debug($tarout) if defined $logger;
        }
        
        #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);
            if (defined $oldts) {
                $logger->info("Deleting old tar file, with time stamp $oldts") if defined $logger;
                unlink $files{$oldts};
            }
            %files = &getFiles($policy->getTargetDir,$policy->getPrefix);
            $cnt--;
        } #end while
    } #end if    
}

sub run {
	my ($self,$now) = @_;
	$now = time unless defined $now;
	
	#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};
		&run_policy($policy,$now,$logger);
	} #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++) {