view release on metacpan or  search on metacpan

lib/Win32/Backup/Robocopy.pm  view on Meta::CPAN

		4   =>  'Some Mismatched files or directories were detected. '.
				'Examine the output log. Housekeeping might be required.',
		8   =>  'Some files or directories could not be copied '.
				'(copy errors occurred and the retry limit was exceeded). '.
				'Check these errors further.',
		16  =>  'Serious error. Robocopy did not copy any files. '.
				'Either a usage error or an error due to insufficient access privileges '.
				'on the source or destination directories.'
	);
	my $exitstr = '';
	foreach my $code(sort {$a<=>$b} keys %exit_code){
		if ( $exit == 0){
			$exitstr .= $exit_code{0};
			last;
		}
		$exitstr .= ' '.$exit_code{$code} if ($exit & $code);
	}
	return $exitstr;	
}
sub _validrange {
	my $range = shift;
	$range =~ s/\s//g;
	my @range;
	# allowed only . , \d \s
	croak 'invalid range ['.$range.'] (allowed only [\s.,\d])!' if $range =~ /[^\s,.\d]/;
	# not allowed a lone .
	croak 'invalid range ['.$range.'] (single .)!' if $range =~ /(?<!\.)\.(?!\.)/;
	# not allowed more than 2 .
	croak 'invalid range ['.$range.'] (more than 2 .)!' if $range =~ /\.{3}/;
	# $1 > $2 like in 25..7
	 if ($range =~ /[^.]\.\.[^.]/){
		foreach my $match ( $range=~/(\d+\.\.\d+)/g ){
			$match=~/(\d+)\.\.(\d+)/;
			croak "$1 > $2 in range [$range]" if $1 > $2;
		}
	}
	@range = eval ($range);
	my %single = map{ $_ => 1} @range;
	@range = sort{ $a <=> $b } keys %single;
	#print "RANGE:@range\n";
	return @range;
}
sub _waitdrive{
	my $self = shift;
	my $drive = shift;
	print 	"\nBackup of:     $self->{src}\n".
			"To:              $self->{dst}\n".
			"Waiting for drive $drive to be available..\n".
			"(press ENTER when $drive is connected or CTRL-C to terminate the program)\n";
	my $input = <STDIN>;
	$self->run();
}
sub _load_conf{ 
	my $file = shift;
	return [] unless -e -r -f $file;
	# READ the configuration 
	my $json = JSON::PP->new->utf8->pretty->canonical;
	open my $fh, '<', $file or croak "unable to read $file";
	my $lines;
	{
		local $/ = '';
		$lines = <$fh>;
	}
	close $fh or croak "impossible to close $file";
	my $data;
	{ 
		local $@;
		eval { $data = $json->decode( $lines ) };
		croak "malformed json in $file!\nJSON error:\n[$@]\n" if $@;
	}
	croak "not an ARRAY ref retrieved from $file as conteainer for jobs! wrong configuration" 
			unless ref $data eq 'ARRAY';
	my @check = qw( name src dst files history cron next_time next_time_descr first_time_run archive
				archiveremove subfolders emptysubfolders verbose waitdrive wait retries);
	my $count = 1;
	foreach my $job ( @$data ){
		croak "not a HASH ref retrieved from $file for job $count! wrong configuration" 
			unless ref $job eq 'HASH';
		map { 
				croak "field [$_] not present in the job $count retrieved from $file" 
				unless exists $job->{ $_ } 
		} @check;
		carp "unexpected elements in job $count  retrieved from $file" if keys %$job > @check;
		$count++;
	}
	return $data;
}
sub _write_conf{
	my $self = shift;
	my $json = JSON::PP->new->utf8->pretty->canonical;
	$json->sort_by( \&_ordered_json );
	# verbosity
	if ( $self->{ verbose } and -e $self->{ conf } ){
		print "overwriting configuration file $self->{ conf }\n";
	}
	open my $fh, '>', $self->{ conf } 
			or croak "unable to write configuration to [$self->{ conf }]";
	print $fh $json->encode( $self->{ jobs } );
	close $fh or croak "unable to close configuration file [$self->{ conf }]";
	# verbosity
	if ( $self->{verbose} > 2 ){
		print "resulting configuration:\n";
		print $json->encode(  $self->{ jobs } );
	}
	# verbosity
	print "wrote configuration file $self->{ conf }\n" if $self->{ verbose };
}
sub _get_cron{
	my $crontab = shift;
	my $cron;
	# a safe scope for $@ 
	{  
		local $@;
		eval { 
				$cron = Algorithm::Cron->new(
												base => 'local',
												crontab => $crontab 
											)
		} or croak "specify a valid cron entry as cron parameter!\n".
					"\tAlgorithm::Cron error is: $@";			
	}