view release on metacpan or  search on metacpan

test/fuse28.pm  view on Meta::CPAN

    foreach my $name ($dir->readdir) {
	push(@list, [$i++, $name]);
    }

    if ($offset < $#list) {
	return (@list[$offset..$#list], 0);
    }

    return (0);
}

sub readdir_test_type_2 {
    my $self = shift;
    my ($path, $offset, $dh) = @_;

    my $dir = $self->{handle}->{$dh};
    return (-2) unless ($dir);

    # print STDERR "readdir_test_type_2, path=$path, offset=$offset\n";

    my $i = 1;
    my @list;

    foreach my $name ($dir->readdir) {
	my $entity = $self->pickup("$path/$name");
	next unless ($entity);

	push(@list, [$i++, $name, [$entity->attr]]);
    }

    if ($offset < $#list) {
	return (@list[$offset..$#list], 0);
    }

    return (0);
}

sub releasedir {
    my $self = shift;
    my ($path, $dh) = @_;

    if ($self->{handle}->{$dh}) {
	$self->release_handle($dh);
	return 0;
    }

    return -2;
}

sub chmod {
    my $self = shift;
    my ($path, $modes) = @_;

    my $entity = $self->pickup($path);
    return -2 unless ($entity);

    $entity->chmod($modes);
}

sub chown {
    my $self = shift;
    my ($path, $uid, $gid) = @_;

    my $entity = $self->pickup($path);
    return -2 unless ($entity);

    $entity->chown($uid, $gid);
}

sub ftruncate {
    my $self = shift;
    my ($path, $offset, $fh) = @_;

    my $entity = $self->{handle}->{$fh};
    return (-2) unless ($entity);
    return (-1) unless ($entity->can('truncate'));

    $entity->truncate($offset);
}

sub truncate {
    my $self = shift;
    my ($path, $offset) = @_;

    my $entity = $self->pickup($path);
    return -2 unless ($entity);
    return -1 unless ($entity->can('truncate'));

    $entity->truncate($offset);
}

sub utime {
    my $self = shift;
    my ($path, $atime, $mtime) = @_;

    # die "utimens must be called";
    return -1;
}

sub open {
    my $self = shift;
    my ($path, $flags, $fileinfo) = @_;

    my $entity = $self->pickup($path);
    return (-2) unless ($entity);

    return (0, $self->issue_handle($entity));
}

sub write {
    my $self = shift;
    my ($path, $buffer, $offset, $fh) = @_;

    my $entity = $self->{handle}->{$fh};
    return (-2) unless ($entity);
    return (-1) unless ($entity->can('write'));

    $entity->write($buffer, $offset);
}

sub read {
    my $self = shift;
    my ($path, $size, $offset, $fh) = @_;

    my $entity = $self->{handle}->{$fh};
    return (-2) unless ($entity);
    return (-1) unless ($entity->can('read'));

test/fuse28.pm  view on Meta::CPAN

    return Errno::EXISTS if ($self->pickup($path));

    my $ret = $dir->mknod($name, $mask, 0);
    return ($ret) if ($ret != 0);

    my $entity = $self->pickup($path);
    return (-2) unless ($entity);

    return (0, $self->issue_handle($entity));
}

package test::fuse28::Entity;

my $last_ino = 0;

sub new {
    my $class = shift;

    my $t = time;

    my $self = {
	# ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	# $atime,$mtime,$ctime,$blksize,$blocks)
	attr => [0, $last_ino++, 0, 1, $>+0, $)+0, 0, 0,
		 $t, $t, $t, 1024, 0],
    };

    $self->{attr}->[8] = $t;
    $self->{attr}->[9] = $t;
    $self->{attr}->[10] = $t;

    bless $self, $class;
}

sub attr {
    my $self = shift;
    return @{$self->{attr}};
}

sub chmod {
    my $self = shift;
    my ($modes) = @_;

    my $attr = $self->{attr}->[2] & ~(07777);
    $self->{attr}->[2] = $attr | $modes;

    return 0;
}

sub utimens {
    my $self = shift;
    my ($atime, $mtime) = @_;

    my $attr = $self->{attr};
    $attr->[8] = $atime if ($atime >= 0);
    $attr->[9] = $mtime if ($mtime >= 0);

    return 0;
}

sub chown {
    my $self = shift;
    my ($uid, $gid) = @_;

    $self->{attr}->[4] = $uid if ($uid >= 0);
    $self->{attr}->[5] = $gid if ($gid >= 0);

    return 0;
}

#
# Directory
#
package test::fuse28::Directory;

use Fcntl qw(:mode);
use base qw(test::fuse28::Entity);
use Scalar::Util qw(weaken);

sub new {
    my $class = shift;
    my $parent = shift;

    my $self = $class->SUPER::new;
    $self->{attr}->[2] = S_IFDIR | S_IRWXU;

    if (!defined($parent)) {
	$self->{parent} = $self;
    }
    else {
	$self->{parent} = $parent;
    }

    $self->{children} = {};

    # avoid cyclic reference
    weaken($self->{parent});

    bless $self, $class;
}

sub parent {
    my $self = shift;
    return $self->{parent};
}

sub entity {
  my $self = shift;
  my $name = shift;

  return $self if ($name eq '.');
  return $self->parent if ($name eq '..');

  return $self->{children}->{$name};
}

sub readdir {
  my $self = shift;
  return ('..', '.', keys %{$self->{children}});
}