File Coverage

blib/lib/DataStore/CAS/FS.pm

Criterion	Covered	Total	%
statement	376	430	87.4
branch	149	236	63.1
condition	89	176	50.5
subroutine	64	78	82.0
pod	21	23	91.3
total	699	943	74.1

package DataStore::CAS::FS;
use 5.008;
use Moo 1.000007;
use Carp;
use Try::Tiny 0.11;
use File::Spec 3.33;
use DataStore::CAS 0.02;

our $VERSION= '0.011000';

require DataStore::CAS::FS::Dir;
require DataStore::CAS::FS::DirCodec::Universal;
require DataStore::CAS::FS::DirCodec::Minimal;
require DataStore::CAS::FS::DirCodec::Unix;

# ABSTRACT: Virtual Filesystem backed by Content-Addressable Storage


has store             => ( is => 'ro', required => 1, isa => \&_validate_cas );
has root_entry        => ( is => 'rwp', required => 1 );
has case_insensitive  => ( is => 'ro', default => sub { 0 } );

sub hash_of_null         { $_[0]->store->hash_of_null }
has hash_of_empty_dir => ( is => 'lazy' );

has dir_cache         => ( is => 'rw', default => sub { DataStore::CAS::FS::DirCache->new() } );

# _nodes is a tree of nodes, each of the form:
# $node= {
#   dirent  => $Dir_Entry,  # mandatory
#   dir     => $CAS_FS_Dir, # optional, created on demand
#   subtree => {
#     KEY1 => $node1,
#     KEY2 => $node2,
#     ...
#   }
#   changed => 1 # set if a path override has happened here, or in any child node
#   invalid => 1 # set whenever a path override deletes this node
# }
#
#  If 'case_insensitive' is true, the keys will all be upper-case, but the $Dir_Entry
#  objects will contain the correct-case name.
#
has _nodes   => ( is => 'rw' );


sub _build_hash_of_empty_dir {
	my $self= shift;
	my $empty= DataStore::CAS::FS::DirCodec::Minimal->encode([],{});
	return $self->store->put_scalar($empty);
}

sub _validate_cas {
	my $cas= shift;
	ref($cas) && ref($cas)->can('get') && ref($cas)->can('put')
		or croak "Invalid CAS object: $cas"
};

sub BUILDARGS {
	my $class= shift;
	my %p= (@_ == 1 && ref $_[0] eq 'HASH')? %{$_[0]} : @_;
	# Root is an alias for root_entry
	if (defined $p{root}) {
		defined $p{root_entry}
			and croak "Specify only one of 'root' or 'root_entry'";
		$p{root_entry}= delete $p{root};
	}
	return \%p;
}

sub BUILD {
	my ($self, $args)= @_;
	my @invalid= grep { !$self->can($_) } keys %$args;
	croak "Invalid param(s): ".join(', ', @invalid)
		if @invalid;

	croak "Missing/Invalid parameter 'dir_cache'"
		unless defined $self->dir_cache and $self->dir_cache->can('clear');

	# coerce root_entry to an actual DirEnt object
	my $root= $self->root_entry;
	defined $root
		or croak "root_entry is required";
	unless (ref $root && ref($root)->isa('DataStore::CAS::FS::DirEnt')) {
		$self->_set_root_entry(
			DataStore::CAS::FS::DirEnt->new({
				type => 'dir',
				name => '',
				# Assume scalars are digest_hash values.
				!ref $root? ( ref => $root )
					# Hashrefs might be empty, to indicate an empty directory
					: ref $root eq 'HASH'? ( ref => $self->hash_of_empty_dir, %$root )
					# Is it a ::File or ::Dir object?
					: ref($root)->can('hash')? ( ref => $root->hash )
					# Else take a guess that it is a digest_hash wrapped in an object
					: ( ref => "$root" )
			})
		);
	}
	croak "Invalid parameter 'root_entry'"
		unless ref $self->root_entry
			and ref($self->root_entry)->can('type')
			and $self->root_entry->type eq 'dir'
			and defined $self->root_entry->ref;
	# If they gave us a 'root_entry', make sure we can load it
	$self->get_dir($self->root_entry->ref)
		or croak "Unable to load root directory '".$self->root_entry->ref."'";
}


sub get {
	(shift)->store->get(@_);
}


sub get_dir {
	my ($self, $hash_or_file, $flags)= @_;
	my ($hash, $file)= (ref $hash_or_file and $hash_or_file->can('hash'))
		? ( $hash_or_file->hash, $hash_or_file )
		: ( $hash_or_file, undef );

	my $dir= $self->dir_cache->get($hash);
	return $dir if defined $dir;

	# Return undef if the directory doesn't exist.
	return undef
		unless defined ($file ||= $self->store->get($hash));

	# Deserialize directory.  This can throw exceptions if it isn't a valid encoding.
	$dir= DataStore::CAS::FS::DirCodec->load($file);
	# Cache it
	$self->dir_cache->put($dir);
	return $dir;
}


sub put        { (shift)->store->put(@_) }
sub put_scalar { (shift)->store->put_scalar(@_) }
sub put_file   { (shift)->store->put_file(@_) }
sub put_handle { (shift)->store->put_handle(@_) }
sub validate   { (shift)->store->validate(@_) }


sub path {
	bless { filesystem => (shift), path_names => [ map { File::Spec->splitdir($_) } @_ ] },
		'DataStore::CAS::FS::Path';
}


sub path_if_exists {
	my $self= shift;
	my $path= $self->path(@_);
	$path->resolve({no_die => 1})? $path : undef;
}


sub tree_iterator {
	my $self= shift;
	my %p= (@_ == 1 && ref $_[0] eq 'HASH')? %{$_[0]} : @_;
	return DataStore::CAS::FS::TreeIterator->new(
		path => [],
		%p,
		fs => $self
	);
}



sub resolve_path {
	my ($self, $path, $flags)= @_;
	$flags ||= {};

	my $ret= $self->_resolve_path(undef, $path, { follow_symlinks => 1, %$flags });

	# Array means success, scalar means error.
	if (ref($ret) eq 'ARRAY') {
		# The user wants directory entries, not "nodes".
		$_= $_->{dirent} for @$ret;
		return $ret;
	}

	# else, got an error...
	${$flags->{error_out}}= $ret
		if ref $flags->{error_out};
	croak $ret unless $flags->{no_die};
	return undef;
}

sub _resolve_path {
	my ($self, $nodes, $path_names, $flags)= @_;

	my @path= ref($path_names)? @$path_names : File::Spec->splitdir($path_names);
	$nodes ||= [];
	push @$nodes, ($self->{_nodes} ||= { dirent => $self->root_entry })
		unless @$nodes;

	my $mkdir_defaults;
	sub _build_mkdir_defaults {
		my $flags= shift;
		my @ret= %{$flags->{mkdir_defaults}}
			if defined $flags->{mkdir_defaults};
		push @ret, type => 'dir', ref => undef;
		\@ret
	}

	while (@path) {
		my $ent= $nodes->[-1]{dirent};
		my $dir;

		# Support for "symlink" is always UNIX-based (or compatible)
		# As support for other systems' symbolic paths are added, they
		# will be given unique '->type' values, and appropriate handling.
		if ($ent->type eq 'symlink' and $flags->{follow_symlinks}) {
			# Sanity check on symlink entry
			my $target= $ent->ref;
			defined $target and length $target
				or return 'Invalid symbolic link "'.$ent->name.'"';

			unshift @path, split('/', $target, -1);
			pop @$nodes;

			# If an absolute link, we start over from the root
			@$nodes= ( $nodes->[0] )
				if $path[0] eq '';

			next;
		}

		if ($ent->type ne 'dir') {
			return 'Cannot descend into directory entry "'.$ent->name.'" of type "'.$ent->type.'"'
				unless ($flags->{mkdir}||0) > 1;
			# Here, mkdir flag converts entry into a directory
			$nodes->[-1]{dirent}= $ent->clone(@{ $mkdir_defaults ||= _build_mkdir_defaults($flags)});
		}

		# Get the next path component, ignoring empty and '.'
		my $name= shift @path;
		next unless defined $name and length $name and ($name ne '.');

		# We handle '..' procedurally, moving up one real directory and *not* backing out of a symlink.
		# This is the same way the kernel does it, but perhaps shell behavior is preferred...
		if ($name eq '..') {
			return "Cannot access '..' at root directory"
				unless @$nodes > 1;
			pop @$nodes;
			next;
		}

		# If this directory has an in-memory override for this name, use it
		my $subnode;
		if ($nodes->[-1]{subtree}) {
			my $key= $self->case_insensitive? uc $name : $name;
			$subnode= $nodes->[-1]{subtree}{$key};
		}

		# Else we need to find the name within the current directory
		if (!defined $subnode && (defined $nodes->[-1]{dir} || defined $ent->ref)) {
			# load it if it isn't cached
			($nodes->[-1]{dir} ||= $self->get_dir($ent->ref))
				or return 'Failed to open directory "'.$ent->name.' ('.$ent->ref.')"';

			# See if the directory contains this entry
			if (defined (my $subent= $nodes->[-1]{dir}->get_entry($name))) {
				$subnode= { dirent => $subent };
				my $key= $self->case_insensitive? uc $name : $name;
				# Weak reference, until _apply_overrides is called.
				Scalar::Util::weaken( $nodes->[-1]{subtree}{$key}= $subnode );
			}
		}

		# If we haven't found one, or if it is 0 (deleted), either create or die.
		if (!$subnode) {
			# If we're supposed to create virtual entries, do so
			if ($flags->{mkdir} or $flags->{partial}) {
				$subnode= {
					invalid => 1, # not valid until _apply_overrides
					dirent => DataStore::CAS::FS::DirEnt->new(
						name => $name,
						# It is a directory if there are more path components to resolve.
						(@path? @{ $mkdir_defaults ||= _build_mkdir_defaults($flags)} : ())
					)
				};
			}
			# Else it doesn't exist and we fail.
			else {
				my $dir_path= File::Spec->catdir(map { $_->{dirent}->name } @$nodes);
				return "Directory \"$dir_path\" is not present in storage"
					unless defined $nodes->[-1]{dir};
				return "No such directory entry \"$name\" at \"$dir_path\"";
			}
		}

		push @$nodes, $subnode;
	}

	$nodes;
}


sub get_dir_entries {
	my ($self, $path)= @_;
	my $nodes= $self->_resolve_path(undef, $path);
	ref $nodes
		or croak $nodes;
	return $self->_get_dir_entries($nodes->[-1]);
}

sub readdir {
	my $self= shift;
	my @names= map { $_->name } @{ $self->get_dir_entries(@_) };
	return wantarray? @names : \@names;
}

# This method combines the original directory with its overrides.
sub _get_dir_entries {
	my ($self, $node)= @_;
	my $ent= $node->{dirent};
	croak "Can't get listing for non-directory"
		unless $ent->type eq 'dir';
	my %dirents;
	# load dir if it isn't cached
	if (!defined $node->{dir} && defined $ent->ref) {
		defined ( $node->{dir}= $self->get_dir($ent->ref) )
			or return 'Failed to open directory "'.$ent->name.' ('.$ent->ref.')"';
	}
	my $caseless= $self->case_insensitive;
	if (defined $node->{dir}) {
		my $iter= $node->{dir}->iterator;
		my $dirent;
		$dirents{$caseless? uc($dirent->name) : $dirent->name}= $dirent
			while defined ($dirent= $iter->());
	}
	if (my $t= $node->{subtree}) {
		for (keys %$t) {
			my $subnode= $t->{$_};
			next unless defined $subnode;
			die "BUG" if ref $subnode && $subnode->{invalid};
			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;
}


sub touch {
	my ($self, $path)= @_;
	$self->update_path($path, { mtime => time() });
}


sub unlink {
	my ($self, $path)= @_;
	$self->set_path($path, undef);
}
*rmdir = *unlink;

# TODO: write copy and move and rename


sub rollback {
	my $self= shift;
	if ($self->{_nodes} && $self->{_nodes}{changed}) {
		&invalidate_node for ($self->{_nodes});
		$self->{_nodes}= undef;
	}
	1;
}


sub commit {
	my $self= shift;
	if ($self->_nodes && $self->_nodes->{changed}) {
		my $root_node= $self->_nodes;
		croak "Root override must be a directory"
			unless $root_node->{dirent}->type eq 'dir';
		my $hash= $self->_commit_recursive($root_node);
		$self->{root_entry}= $root_node->{dirent}->clone(ref => $hash);
		$self->{_nodes}= undef;
	}
	1;
}

# Takes a subtree of the datastructure generated by apply_path and encodes it
# as a directory, recursively encoding any subtrees first, then returns the
# hash of that subdir.
sub _commit_recursive {
	my ($self, $node)= @_;

	my %changes;
	my @entries;
	if (my $subtree= $node->{subtree}) {
		while (my ($k, $v)= each %{$node->{subtree}}) {
			$changes{$k}= $v
				if defined $v && ($v eq 0 || $v->{changed});
		}
	}

	# If no changes, return original directory (if it exists)
	return $node->{dirent}->ref
		if !%changes && defined $node->{dirent}->ref;

	# Walk the directory entries and filter out any that have been overridden.
	if (defined $node->{dir} || defined $node->{dirent}->ref) {
		($node->{dir} ||= $self->get_dir($node->{dirent}->ref))
			or croak 'Failed to open directory "'.$node->{dirent}->name.' ('.$node->{dirent}->ref.')"';

		my ($iter, $ent);
		my $caseless= $self->case_insensitive;
		for ($iter= $node->{dir}->iterator; defined ($ent= $iter->()); ) {
			push @entries, $ent unless $changes{$caseless? uc($ent->name) : $ent->name};
		}
	}

	# Now append the modified entries.
	# Skip the "0"s, which represent files to unlink.
	for (grep { ref $_ } values %changes) {
		# Check if node is a dir and needs committed
		if ($_->{subtree} and $_->{dirent}->type eq 'dir' and $_->{changed}) {
			my $hash= $self->_commit_recursive($_);
			$_->{dirent}= $_->{dirent}->clone( ref => $hash );
		}

		push @entries, $_->{dirent};
	}

	# Invalidate all children of this node
	&_invalidate_subtree for ($node);

	# Now re-encode the directory, using the same type as orig_dir
	return $self->hash_of_empty_dir
		unless @entries;
	my $format= $node->{dir}->format
		if $node->{dir};
	$format= 'universal' unless defined $format;
	return DataStore::CAS::FS::DirCodec->put($self->store, $format, \@entries, {});
}

package DataStore::CAS::FS::Path;
use strict;
use warnings;


# main attributes
sub path_names       { $_[0]{path_names} }
sub filesystem       { $_[0]{filesystem} }
#sub _node_path       { $_[0]{_node_path} }

# convenience accessors
sub path_name_list   { @{$_[0]->path_names} }
sub path_dirent_list { map { $_->{dirent} } @{$_[0]->resolve} }
sub path_dirents     { [ $_[0]->path_dirent_list ] }
sub dirent           { $_[0]->resolve->[-1]{dirent} }
sub type             { $_[0]->resolve->[-1]{dirent}->type }
sub name             { $_[0]->resolve->[-1]{dirent}->name }
sub depth            { -1 + @{$_[0]->resolve} }


sub canonical_path {
	my $self= shift;
	$self->{canonical_path} ||= do {
		my $name= $self->path_names;
		my $path= '/'.join('/', grep { length && $_ ne '.' } @$name);
		$path .= '/' if $name->[-1] eq '' || $name->[-1] eq '.';
		$path =~ s|//+|/|g;
		$path;
	};
}


sub resolved_canonical_path {
	my $x= $_[0]->resolve;
	# ignore name of root entry
	return '/'.join('/', map { $_->{dirent}->name } @$x[1..$#$x]);
}


sub resolve {
	# See if we can re-use the previous result...
	my $nodes= $_[0]{_node_path};
	return $nodes if $nodes && ref $nodes->[-1] && !$nodes->[-1]{invalid};
	# Only re-resolve the nodes which have been invalidated.
	# This is part of an optimization to create half-resolved path objects.
	my ($self, $flags)= @_;
	my (@valid_nodes, $sub_path);
	if ($nodes) {
		for (@$nodes) {
			last if !ref $_ || $_->{invalid};
			push @valid_nodes, $_;
		}
		$sub_path= [ map { ref $_? $_->{dirent}->name : $_ } @{$nodes}[ scalar(@valid_nodes) .. $#$nodes ] ];
	} else {
		$sub_path= $self->{path_names};
	}
	$flags= { follow_symlinks => 1, $flags? %$flags : () };
	$nodes= $self->{filesystem}->_resolve_path(\@valid_nodes, $sub_path, $flags);
	if (ref $nodes) {
		return ($self->{_node_path}= $nodes);
	} else {
		# else, got an error...
		${$flags->{error_out}}= $nodes
			if ref $flags->{error_out};
		Carp::croak $nodes unless $flags->{no_die};
		return undef;
	}
}


sub path {
	my $self= shift;
	my @sub_names= map { File::Spec->splitdir($_) } @_;
	bless {
		filesystem => $self->{filesystem},
		path_names => [ @{$self->{path_names}}, @sub_names ],
		$self->{_node_path}? (_node_path => [ @{$self->{_node_path}}, @sub_names ]) : (),
	}, ref $self;
}

sub path_if_exists {
	my $self= shift;
	my $path= $self->path(@_);
	$path->resolve({no_die => 1})? $path : undef;
}


sub mkdir {
	my $self= shift;
	$self->{filesystem}->mkdir($self->path_names, @_);
	$self;
}


sub file {
	$_[0]{file} ||= do {
		my $ent= $_[0]->dirent;
		$ent->type eq 'file' or Carp::croak "Path is not a file";
		defined (my $hash= $ent->ref) or Carp::croak "File was not stored in CAS";
		$_[0]->filesystem->get($hash);
	};
}

sub open {
	$_[0]->file->open
}


sub dir {
	$_[0]{dir} ||= do {
		my $ent= $_[0]->dirent;
		$ent->type eq 'dir' or Carp::croak "Path is not a directory";
		defined (my $hash= $ent->ref) or Carp::croak "Directory was not stored in CAS";
		$_[0]->filesystem->get_dir($hash);
	}
}


sub readdir {
	$_[0]{filesystem}->readdir($_[0]->path_names)
}


sub tree_iterator {
	my $self= shift;
	my %p= (@_ == 1 && ref $_[0] eq 'HASH')? %{$_[0]} : @_;
	$self->filesystem->tree_iterator(%p, path => $self->path_names);
}

package DataStore::CAS::FS::TreeIterator;
use strict;
use warnings;
use Carp;


sub _fields { $_[0]->($_[0]) }

sub new {
	my $class= shift;
	my $self= bless { (@_ == 1 && ref $_[0] eq 'HASH')? %{$_[0]} : @_ }, $class;
	defined $self->{$_} || croak "'$_' is required"
		for qw( path fs );
	$self->{path_nodes}= \my @nodes;
	$self->{dirstack}= \my @dirstack;
	$self->{names}= \my @names;
	$self->{filterref}= \my $filter;
	$filter= delete $self->{filter};
	my $fs= $self->{fs};
	$self->_init;
	return bless sub {
		return $self if @_ && ref($_[0]) eq $class;
		return undef unless @dirstack;
		# back out of a directory hierarchy that we have finished
		while (!@{$dirstack[-1]}) {
			pop @dirstack; # back out of directory
			pop @nodes;
			pop @names;
			return undef unless @dirstack;
		}
		# Iterate path leaf, by removing last leaf, and resolving using the
		#  next name.
		pop @nodes;
		$names[-1]= shift @{$dirstack[-1]};
		$fs->_resolve_path(\@nodes, [ $names[-1] ]);
		my $p= bless {
				path_names => \@names,
				path_dirents  => \@nodes,
				filesystem => $fs,
			}, 'DataStore::CAS::FS::Path';
		# If a dir, push it onto the stack
		if ($p->type eq 'dir') {
			push @dirstack, [ map { $_->name } @{ $fs->_get_dir_entries($nodes[-1]) } ];
			push @nodes, undef;
			push @names, undef;
		}
		return $p;
	}, $class;
}

sub _init {
	my $self= shift;
	# _resolve_path returns a string on failure
	my $x;
	ref( $x= $self->{fs}->_resolve_path(undef, $self->{path}) )
		or croak $x;
	# maintain an array of resolved path nodes, and an array of
	#  arrays of names-to-iterate for each directory
	@{$self->{path_nodes}}= @$x;
	@{$self->{names}}= map { $_->{dirent}->name } @$x;
	@{$self->{dirstack}}= ([]) x @$x;
	push @{$self->{dirstack}[-1]}, $self->{names}[-1];
}

sub reset {
	$_[0]->($_[0])->_init;
	1;
}

sub skip_dir {
	my $self= $_[0]->($_[0]);
	@{$self->{dirstack}[-1]}= ()
		if @{$self->{dirstack}};
	1;
}

package DataStore::CAS::FS::DirCache;
use strict;
use warnings;


sub size {
	if (@_ > 1) {
		my ($self, $new_size)= @_;
		$self->{size}= $new_size;
		$self->{_recent}= [];
		$self->{_recent_idx}= 0;
	}
	$_[0]{size};
}

sub new {
	my $class= shift;
	my %p= ref($_[0])? %{$_[0]} : @_;
	$p{size} ||= 32;
	$p{_by_hash} ||= {};
	$p{_recent} ||= [];
	$p{_recent_idx} ||= 0;
	bless \%p, $class;
}

sub clear {
	$_= undef for @{$_[0]{_recent}};
	$_[0]{_by_hash}= {};
}

sub get {
	return $_[0]{_by_hash}{$_[1]};
}

sub put {
	my ($self, $dir)= @_;
	# Hold onto a strong reference for a while.
	$self->{_recent}[ $self->{_recent_idx}++ ]= $dir;
	$self->{_recent_idx}= 0 if $self->{_recent_idx} > @{$self->{_recent}};
	# Index it using a weak reference.
	Scalar::Util::weaken( $self->{_by_hash}{$dir->hash}= $dir );
	# Now, a nifty hack: we attach an object to watch for the destriction of the
	# directory.  Lazy references will get rid of the dir object, but this cleans
	# up our _by_hash index.
	$dir->{'#DataStore::CAS::FS::DirCacheCleanup'}=
		bless [ $self->{_by_hash}, $dir->hash ], 'DataStore::CAS::FS::DirCacheCleanup';
}

package DataStore::CAS::FS::DirCacheCleanup;
use strict;
use warnings;

sub DESTROY { delete $_[0][0]{$_[0][1]}; }

1;

__END__