view release on metacpan or  search on metacpan

lib/App/MtAws/Journal.pm  view on Meta::CPAN

		#" CREATED $archive_id $data->{filesize} $data->{final_hash} $data->{relfilename}"
		defined( $e->{$_} ) || confess "bad $_" for (qw/time archive_id size treehash relfilename/);
		confess "invalid filename" unless is_relative_filename($e->{relfilename});
		my $mtime = defined($e->{mtime}) ? $e->{mtime} : 'NONE';
		$self->_write_line("B\t$e->{time}\tCREATED\t$e->{archive_id}\t$e->{size}\t$mtime\t$e->{treehash}\t$e->{relfilename}");
	} elsif ($e->{type} eq 'DELETED') {
		#  DELETED $data->{archive_id} $data->{relfilename}
		defined( $e->{$_} ) || confess "bad $_" for (qw/archive_id relfilename/);
		confess "invalid filename" unless is_relative_filename($e->{relfilename});
		$self->_write_line("B\t$e->{time}\tDELETED\t$e->{archive_id}\t$e->{relfilename}");
	} elsif ($e->{type} eq 'RETRIEVE_JOB') {
		#  RETRIEVE_JOB $data->{archive_id}
		defined( $e->{$_} ) || confess "bad $_" for (qw/archive_id job_id/);
		$self->_write_line("B\t$e->{time}\tRETRIEVE_JOB\t$e->{archive_id}\t$e->{job_id}");
	} else {
		confess "Unexpected else";
	}
}

sub _write_line
{
	my ($self, $line) = @_;
	confess unless $self->{append_file};
	confess unless print { $self->{append_file} } $line."\n";
	# TODO: fsync()
}

#
# Reading file listing
#


sub read_files
{
	my ($self, $mode, $max_number_of_files) = @_;

	my %checkmode = %$mode;
	defined $checkmode{$_} && delete $checkmode{$_} for qw/new existing missing/;
	confess "Unknown mode: ".join(';', keys %checkmode) if %checkmode;

	confess unless defined($self->{root_dir});

	my %missing = $mode->{'missing'} ? %{$self->{journal_h}} : ();

	$self->{listing} = { new => [], existing => [], missing => [] };
	my $i = 0;
	# TODO: find better workaround than "-s"
	$File::Find::prune = 0;
	$File::Find::dont_use_nlink = !$self->{leaf_optimization};

	File::Find::find({ wanted => sub {
		if ($self->_listing_exceeed_max_number_of_files($max_number_of_files)) {
			$File::Find::prune = 1;
			return;
		}

		if (++$i % 1000 == 0) {
			print "Found $i local files\n";
		}

		# note that this exception is probably thrown even if a directory below transfer root contains invalid chars
		die exception(invalid_chars_filename => "Not allowed characters in filename: %filename%", filename => hex_dump_string($_))
			if /[\r\n\t]/;

		if (-d) {
			my $dir = character_filename($_);
			$dir =~ s!/$!!; # make sure there is no trailing slash. just in case.
			my $reldir = abs2rel($dir, $self->{root_dir}, allow_rel_base => 1);
			if ($self->{filter} && $reldir ne '.') {
				my ($match, $matchsubdirs) = $self->{filter}->check_dir($reldir."/");
				if (!$match && $matchsubdirs) {
					$File::Find::prune = 1;
				}
			}
		} else {
			# file can be not existing here (i.e. dangling symlink)
			my $filename = character_filename(my $binaryfilename = $_);
			my $orig_relfilename = abs2rel($filename, $self->{root_dir}, allow_rel_base => 1);
			if ($self->check_filenames($orig_relfilename)) {
				if ($self->_is_file_exists($binaryfilename)) {
					my $relfilename;
					confess "Invalid filename: ".hex_dump_string($orig_relfilename)
						unless defined($relfilename = sanity_relative_filename($orig_relfilename));
					if (my $use_mode = $self->_can_read_filename_for_mode($orig_relfilename, $mode)) {
						push @{$self->{listing}{$use_mode}}, { relfilename => $relfilename }; # TODO: we can reduce memory usage even more. we don't need hash here probably??
					}
					delete $missing{$relfilename} if ($mode->{missing});
				}
			}
		}
	}, no_chdir => 1, $self->{follow} ? (follow => 1, follow_skip => 2) : () }, (binaryfilename($self->{root_dir})));

	if ($mode->{missing} && !$self->_listing_exceeed_max_number_of_files($max_number_of_files)) {
		for (keys %missing) {
			unless ($self->_is_file_exists(binaryfilename $self->absfilename($_))) {
				push @{$self->{listing}{missing}}, { relfilename => $_ };
				last if $self->_listing_exceeed_max_number_of_files($max_number_of_files);
			}
		}
	}
}

sub _listing_exceeed_max_number_of_files
{
	my ($self, $max_number_of_files) = @_;
	($max_number_of_files && (
		(
			(scalar @{$self->{listing}{new}}) +
			(scalar @{$self->{listing}{existing}}) +
			(scalar @{$self->{listing}{missing}})
		)  >= $max_number_of_files)
	);
}

sub character_filename
{
	my ($binaryfilename) = @_;
	my $filename;
	my $enc = get_filename_encoding();
	die exception invalid_octets_filename => "Invalid octets in filename, does not map to desired encoding %string enc%: %filename%",
		enc => $enc, filename => hex_dump_string($binaryfilename),