view release on metacpan or  search on metacpan

lib/DataStore/CAS/FS.pm  view on Meta::CPAN

			if (ref $subnode) {
				$dirents{$_}= $subnode->{dirent}
					if $subnode->{changed};
			} else {
				delete $dirents{$_};
			}
		}
	}
	return [ map { $dirents{$_} } sort keys %dirents ];
}


sub set_path {
	my ($self, $path, $newent, $flags)= @_;
	$flags ||= {};
	my $nodes= $self->_resolve_path(undef, $path, { follow_symlinks => 1, partial => 1, %$flags });
	croak $nodes unless ref $nodes;
	# replace the final entry, after applying defaults
	if (!$newent) {
		# unlink request.  Ignore if node didn't exist.
		return if $nodes->[-1]{invalid};

		# Can't unlink the root node
		croak "Can't unlink root node"
			unless @$nodes > 1;

		$nodes->[-1]{invalid}= 1;
		# Recursively invalidate all nodes beneath this one
		&_invalidate_subtree for ($nodes->[-1]);

		# Mark in prev node that this item is gone
		my $key= $self->case_insensitive? uc $nodes->[-1]{dirent}->name : $nodes->[-1]{dirent}->name;
		pop @$nodes;
		$nodes->[-1]{subtree}{$key}= 0;
	} else {
		if (ref $newent eq 'HASH' or !defined $newent->name or !defined $newent->type) {
			my %ent_hash= %{ref $newent eq 'HASH'? $newent : $newent->as_hash};
			$ent_hash{name}= $nodes->[-1]{dirent}->name
				unless defined $ent_hash{name};
			defined $ent_hash{name} && length $ent_hash{name}
				or die "No name for new dir entry";
			$ent_hash{type}= $nodes->[-1]{dirent}->type || 'file'
				unless defined $ent_hash{type};
			$newent= DataStore::CAS::FS::DirEnt->new(\%ent_hash);
		}
		$nodes->[-1]{dirent}= $newent;
		delete $nodes->[-1]{dir};
		# Recursively invalidate all nodes beneath this one
		&_invalidate_subtree for ($nodes->[-1]);
	}
	# Now connect nodes with strong references, and mark as changed
	$self->_apply_overrides($nodes);
}
sub _invalidate_subtree {
	if ($_->{subtree}) {
		++$_->{invalid} && &_invalidate_subtree for grep { ref $_ } values %{delete $_->{subtree}};
	}
}


sub update_path {
	my ($self, $path, $changes, $flags)= @_;
	$flags ||= {};
	my $nodes= $self->_resolve_path(undef, $path, { follow_symlinks => 1, partial => 1, %$flags });
	croak $nodes unless ref $nodes;

	# update the final entry, after applying defaults
	my $entref= \$nodes->[-1]{dirent};
	my $old_dir_ref= defined $$entref->type && $$entref->type eq 'dir'? $$entref->ref : undef;
	$$entref= $$entref->clone(
		(defined $$entref->type? () : ( type => 'file' )),
		ref $changes eq 'HASH'? %$changes
			: ref $changes eq 'ARRAY'? @$changes
			: croak 'parameter "changes" must be a hashref or arrayref'
	);
	my $new_dir_ref= $$entref->type eq 'dir'? $$entref->ref : undef;

	# If we changed the type of a directory, or changed which digest_hash it
	# refers to, then we should clear the subtree under this node.
	if (($old_dir_ref || '') ne ($new_dir_ref || '') && $nodes->[-1]{subtree}) {
		# Recursively invalidate all nodes beneath this one
		&_invalidate_subtree for ($nodes->[-1]);
		delete $nodes->[-1]{dir};
	}

	$self->_apply_overrides($nodes);
}

sub _apply_overrides {
	my ($self, $nodes)= @_;
	# Ensure that each node is connected to the previous via 'subtree'.
	# When we find the first changed node, we assume the rest are connected.
	my $prev;
	for (reverse @$nodes) {
		if ($prev) {
			my $key= $self->case_insensitive? uc($prev->{dirent}->name) : $prev->{dirent}->name;
			$_->{subtree}{$key}= $prev;
		}
		last if $_->{changed} && !$_->{invalid};
		delete $_->{invalid};
		$_->{changed}= 1;
		$prev= $_;
	}
	# Finally, make sure the root override is set
	$self->{_nodes}= $nodes->[0];
	1;
}


sub mkdir {
	my ($self, $path)= @_;
	my $nodes= $self->_resolve_path(undef, $path, { follow_symlinks => 1, mkdir => 1 });
	croak $nodes unless ref $nodes;
	unless (defined $nodes->[-1]{dirent}->type) {
		$nodes->[-1]{dirent}= $nodes->[-1]{dirent}->clone(type => 'dir');
		$self->_apply_overrides($nodes);
	}
	1;
}