view release on metacpan or  search on metacpan

lib/App/SimpleBackuper/Backup.pm  view on Meta::CPAN

package App::SimpleBackuper;

use strict;
use warnings;
use feature ':5.14';
use Carp;
use Try::Tiny;
use Time::HiRes qw(time);
use Const::Fast;
use App::SimpleBackuper::BackupDB;
use App::SimpleBackuper::_format;
use App::SimpleBackuper::_BlockDelete;
use App::SimpleBackuper::_BlocksInfo;

const my $SIZE_OF_TOP_FILES => 10;
const my $SAVE_DB_PERIOD => 60 * 60;
const my $PRINT_PROGRESS_PERIOD => 60;

sub _proc_uid_gid($$$) {
	my($uid, $gid, $uids_gids) = @_;
	
	my $last_uid_gid = @$uids_gids ? $uids_gids->unpack( $uids_gids->[-1] )->{id} : 0;
	
	my $user_name = getpwuid($uid);
	my($user) = grep { $_->{name} eq $user_name } map { $uids_gids->unpack($_) } @$uids_gids;
	if(! $user) {
		$user = {id => ++$last_uid_gid, name => $user_name};
		$uids_gids->upsert({ id => $user->{id} }, $user );
		#printf "new owner user added (unix uid %d, name %s, internal uid %d)\n", $uid, $user_name, $user->{id};
	}
	$uid = $user->{id};
	
	my $group_name = getgrgid($gid);
	my($group) = grep { $_->{name} eq $group_name } map { $uids_gids->unpack($_) } @$uids_gids;
	if(! $group) {
		$group = {id => ++$last_uid_gid, name => $group_name};
		$uids_gids->upsert({ id => $group->{id} }, $group );
		#printf "new owner group added (unix gid %d, name %s, internal gid %d)\n", $gid, $group_name, $group->{id};
	}
	$gid = $group->{id};
	
	return $uid, $gid;
}

sub _get_block_to_delete {
	my($state) = @_;
	
	if(ref($state->{blocks2delete_prio2size2chunks}) eq 'HASH') {
		$state->{blocks2delete_prio2size2chunks} = [
			map {$state->{blocks2delete_prio2size2chunks}->{ $_ }}
			sort {$a <=> $b}
			keys %{ $state->{blocks2delete_prio2size2chunks} }
		];
	}
	
	return if ! @{ $state->{blocks2delete_prio2size2chunks} };
	
	if(ref($state->{blocks2delete_prio2size2chunks}->[0]) eq 'HASH') {
		$state->{blocks2delete_prio2size2chunks}->[0] = [
			map {$state->{blocks2delete_prio2size2chunks}->[0]->{ $_ }}
			sort {$b <=> $a}
			keys %{ $state->{blocks2delete_prio2size2chunks}->[0] }
		];
	}
	
	my $prio_basket = $state->{blocks2delete_prio2size2chunks}->[0];
	my $size_basket = $prio_basket->[0];
	my $block_id = shift @$size_basket;
	shift @$prio_basket if ! @$size_basket;
	shift @{ $state->{blocks2delete_prio2size2chunks} } if ! @$prio_basket;
	
	return $block_id;
}

sub Backup {
	my($options, $state) = @_;
	
	my($backups, $files, $parts, $blocks) = @{ $state->{db} }{qw(backups files parts blocks)};
	
	die "Backup '$options->{\"backup-name\"}' already exists" if grep { $backups->unpack($_)->{name} eq $options->{'backup-name'} } @$backups;
	
	$state->{$_} = 0 foreach qw(last_backup_id last_file_id last_block_id bytes_processed bytes_in_last_backup total_weight);
	
	print "Preparing to backup: " if $options->{verbose};

lib/App/SimpleBackuper/Backup.pm  view on Meta::CPAN

	
	my $backup = $backups->find_row({ id => $state->{last_backup_id} });
	$backup->{is_done} = 1;
	$backups->upsert({ id => $backup->{id} }, $backup );
	
	App::SimpleBackuper::BackupDB($options, $state);
	
	_print_progress($state) if ! $options->{quiet};
}

sub _print_progress {
	print "Progress: ";
	if($_[0]->{bytes_in_last_backup}) {
		printf "processed %s of %s in last backup, ", fmt_weight($_[0]->{bytes_processed}), fmt_weight($_[0]->{bytes_in_last_backup});
	}
	printf "total backups weight %s.\n", fmt_weight($_[0]->{total_weight});
}

use Text::Glob qw(match_glob);
use Fcntl ':mode'; # For S_ISDIR & same
use App::SimpleBackuper::RegularFile;

sub _file_proc {
	my($task, $options, $state) = @_;
	
	confess "No task" if ! $task;
	confess "No filepath" if ! $task->[0];
	
	my @next;
	my $file_time_spent = 0;
	my $file_weight_spent = 0;
	
	print "$task->[0]\n" if $options->{verbose};
	print "\tparent #$task->[2], priority $task->[1]" if $options->{verbose};
	
	my $priority = $task->[1];
	while(my($mask, $p) = each %{ $options->{files} }) {
		if(match_glob( $mask, $task->[0] )) {
			$priority = $p;
			print ", priority $priority by rule '\"$mask\": $p'" if $options->{verbose};
		}
	}
	
	if(! $priority) { # Excluded by user
		print " -> skip\n" if $options->{verbose};
		return;
	}
	
	$state->{profile}->{fs} -= time;
	$state->{profile}->{fs_lstat} -= time;
	$file_time_spent -= time;
	my @stat = lstat($task->[0]);
	$file_time_spent += time;
	$state->{profile}->{fs} += time;
	$state->{profile}->{fs_lstat} += time;
	if(! @stat) {
		print ". Not exists\n" if $options->{verbose};
		return;
	}
	else {
		printf ", stat: %s:%s %o %s modified at %s", scalar getpwuid($stat[4]), scalar getgrgid($stat[5]), $stat[2], fmt_weight($stat[7]), fmt_datetime($stat[9]) if $options->{verbose};
	}
	
	
	my($backups, $blocks, $files, $parts, $uids_gids) = @{ $state->{db} }{qw(backups blocks files parts uids_gids)};
	
	
	my($uid, $gid) = _proc_uid_gid($stat[4], $stat[5], $uids_gids);
	
	
	my($file); {
		my($filename) = $task->[0] =~ /([^\/]+)\/?$/;
		$file = $files->find_by_parent_id_name($task->[2], $filename);
		if($file) {
			print ", is old file #$file->{id}" if $options->{verbose};
			if($file->{versions}->[-1]->{backup_id_max} == $state->{last_backup_id}) {
				print ", is already backuped.\n" if $options->{verbose};
				return;
			}
		} else {
			$file = {
				parent_id	=> $task->[2],
				id			=> ++$state->{last_file_id},
				name		=> $filename,
				versions	=> [],
			};
			print ", is new file #$file->{id}" if $options->{verbose};
		}
	}
	
	$state->{bytes_processed} += $file->{versions}->[-1]->{size} if @{ $file->{versions} };
	
	my %version = (
		backup_id_min	=> $state->{last_backup_id},
		backup_id_max	=> $state->{last_backup_id},
		uid				=> $uid,
		gid				=> $gid,
		size			=> $stat[7],
		mode			=> $stat[2],
		mtime			=> $stat[9],
		block_id		=> undef,
		symlink_to		=> undef,
		parts			=> [],
	);
	
	if(S_ISDIR $stat[2]) {
		print ", is directory.\n" if $options->{verbose};
		my $dh;
		
		$state->{profile}->{fs} -= time;
		$state->{profile}->{fs_read_dir} -= time;
		$file_time_spent -= time;
		if(! opendir($dh, $task->[0])) {
			$state->{profile}->{fs} += time;
			$state->{profile}->{fs_read_dir} += time;
			push @{ $state->{fails}->{$!} }, $task->[0];
			print ", can't read: $!\n" if $options->{verbose};
			return;
		}
		my @files;
		while(my $f = readdir($dh)) {