view release on metacpan or  search on metacpan

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

		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}) {

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

	# 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__

=pod

=head1 NAME

DataStore::CAS::FS - Virtual Filesystem backed by Content-Addressable Storage

=head1 VERSION

version 0.011000

=head1 SYNOPSIS

  # Create a new empty filesystem
  my $casfs= DataStore::CAS::FS->new(
    store => DataStore::CAS::Simple->new(
      path => './foo/bar',
      create => 1,
      digest => 'SHA-256'
    )
  );
  
  # Open an existing root directory on an existing store
  $casfs= DataStore::CAS::FS->new( store => $cas, root => $digest_hash );
  
  # --- These pass through to the $cas module
  
  $hash= $casfs->put("Blah");
  $hash= $casfs->put_file("./foo/bar/baz");
  $file= $casfs->get($hash);
  
  # Open a path within the filesystem
  $handle= $casfs->path('1','2','3','myfile')->open;
  
  # Make some changes
  $casfs->apply_path(['1', '2', 'myfile'], { ref => $some_new_file });
  $casfs->apply_path(['1', '2', 'myfile_copy'], { ref => $some_new_file });
  # Commit them
  $casfs->commit();

=head1 DESCRIPTION

DataStore::CAS::FS extends the L<DataStore::CAS> API to support directory
objects which let you store store traditional file hierarchies in the CAS,