package Hurd::Trivfs;

use Errno ();

use Exporter ();
@ISA = ('Exporter', 'Hurd::Trivfs::_Hooky');
$VERSION = '0.003';

require DynaLoader;
*dl_load_flags = \&DynaLoader::dl_load_flags;
DynaLoader::bootstrap ('Hurd::Trivfs', $VERSION);


BEGIN {
    @EXPORT = qw(
		 $fstype
		 $fsid
		 $allow_open
		 $support_read
		 $support_write
		 $support_exec
		);
}

use vars @EXPORT;

use strict;

tie ($fstype,		"Hurd::Trivfs::Param", 0);
tie ($fsid,		"Hurd::Trivfs::Param", 1);
tie ($allow_open,	"Hurd::Trivfs::Param", 2);
tie ($support_read,	"Hurd::Trivfs::Param", 3);
tie ($support_write,	"Hurd::Trivfs::Param", 4);
tie ($support_exec,	"Hurd::Trivfs::Param", 5);

sub start {
    my ($class, %args) = @_;
    my ($bootstrap, $cntl, $timeout);

    $bootstrap = Mach::Task::_get_bootstrap_port ()
	or die "Must be started as a translator.\n";
    $cntl = bless _startup ($bootstrap), $class;
    Mach::Port::_deallocate (0, $bootstrap);
    $cntl->hook ($args{hook});

    # Default timeout is 2 minutes.
    $timeout = 2 * 60 * 1000 unless defined ($timeout = $args{timeout});

#    Hurd::Trivfs::wait();

    # XXX _go will be replaced once Hurd::Ports shapes up.
    _go ($cntl, $timeout);
}

sub goaway { exit 0; }

sub init_peropen { return 1; }

sub init_protid { return 1; }

sub io_write {
    die if $support_write;
    $! = Errno::EOPNOTSUPP;
    return undef;
}

sub io_read {
    die if $support_read;
    $! = Errno::EOPNOTSUPP;
}

sub io_seek {
    die if $support_read || $support_write;
    $! = Errno::EOPNOTSUPP;
    return undef;
}

sub io_readable {
    die if $support_read;
    $! = Errno::EOPNOTSUPP;
    return undef;
}

sub io_set_all_openmodes {
    $! = Errno::EOPNOTSUPP;
    return undef;
}

sub io_get_openmodes     {
    $! = Errno::EOPNOTSUPP;
    return undef;
}

sub io_set_some_openmodes   {
    $! = Errno::EOPNOTSUPP;
    return undef;
}

sub io_clear_some_openmodes {
    $! = Errno::EOPNOTSUPP;
    return undef;
}

sub file_set_size {
    die if $support_write;
    $! = Errno::EOPNOTSUPP;
}


package Hurd::Trivfs::Param;

# This package maps Perl variables like $support_read to their libtrivfs
# counterparts.

sub TIESCALAR {
    my ($class, $code) = @_;
    return bless \$code, $class;
}

# FETCH and STORE methods are implemented in C.


package Hurd::Trivfs::Peropen;

{ no strict; @ISA = ('Hurd::Trivfs::_Hooky'); }

# XXX This init interface is likely to disappear.
sub init {
    $_[0]->cntl->init_peropen (@_);
    return 1;
}


package Hurd::Trivfs::Protid;

{ no strict; @ISA = ('Hurd::Trivfs::_Hooky'); }

# XXX This init interface is likely to disappear.
sub init {
    $_[0]->po->cntl->init_protid (@_);
    return 1;
}

# I want to do something different with this...
sub modify_stat { }

sub io_write             { return $_[0]->po->cntl->io_write (@_); }
sub io_read              {        $_[0]->po->cntl->io_read (@_); }
sub io_seek              { return $_[0]->po->cntl->io_seek (@_); }
sub io_readable          { return $_[0]->po->cntl->io_readable (@_); }
sub io_set_all_openmodes {        $_[0]->po->cntl->io_set_all_openmodes (@_); }
sub io_get_openmodes     { return $_[0]->po->cntl->io_get_openmodes (@_); }
sub io_set_some_openmodes   { $_[0]->po->cntl->io_set_some_openmodes (@_); }
sub io_clear_some_openmodes { $_[0]->po->cntl->io_clear_some_openmodes (@_); }

sub file_set_size        {        $_[0]->po->cntl->file_set_size (@_); }


package Hurd::Trivfs::_Hooky;  # impelmented in XS


package Hurd::Trivfs::_;

# Entry points from C.  These are NOT part of the Hurd::Trivfs public
# interface.  They just perform method lookups and transform semantics
# from C-friendly to Perl-friendly and back.


###
### Functions specific to libtrivfs.
###

# $STAT is an arrayref of the normal Perl stat fields followed by some
# extra Hurd specific ones: st_fstype, st_gen, st_author, st_flags.
# The file times are floating point to preserve the Hurd's sub-second
# granularity.
sub modify_stat {
    my ($cred, $stat) = @_;
    $cred->modify_stat ($stat);
    return 0;
}

# Called when the parent filesystem wants to shut us down.  Normally
# just exits the process.
sub goaway {
    my ($cred, $flags) = @_;
    local ($!);
    $cred->goaway ($flags);
    return $!;
}

# XXX This interface will probably disappear.
# Called after constructing a Peropen structure during an `open' operation.
sub peropen_init {
    my ($po) = @_;
    local ($!);
    $po->init;
    return $!;
}

# XXX This interface will probably disappear.
# Called after constructing a Protid structure during an `open',
# `io_reauthenticate', `io_restrict_auth', or `io_duplicate' operation.
sub protid_init {
    my ($prot) = @_;
    local ($!);
    $prot->init;
    return $!;
}

###
### I/O interface.
###

# Write the first $$AMOUNT_REF bytes of $BUFFER to file offset $OFFSET.
# This meaning of offset differs from that used in Perl's `syswrite'.
# If offset is -1, read from the object maintained file pointer.  If the
# object is not seekable, offset is ignored.  Return the amount written
# in $$AMOUNT_REF.
sub io_write {
    my ($prot, $buffer, $offset, $amount_ref) = @_;
    local ($!);
    return Errno::EOPNOTSUPP if not $prot;
    $$amount_ref = $prot->io_write ($buffer, $offset, $$amount_ref);
    return $!;
}

# Read data from an IO object at file offset $OFFSET into $$BUFFER_REF.
# This meaning of offset differs from Perl's `sysread'.
# If offset is -1, read from the object maintained file pointer.  If the
# object is not seekable, offset is ignored.  The amount desired to be
# read is in $AMOUNT.  $$BUFFER_REF is initially passed as an empty string.
sub io_read {
    my ($prot, $buffer_ref, $offset, $amount) = @_;
    local ($!);
    return Errno::EOPNOTSUPP if not $prot;
    $prot->io_read ($buffer_ref, $offset, $amount);
    return $!;
}

# Change current read/write offset.
sub io_seek {
    my ($prot, $offset_ref, $whence) = @_;
    local ($!);
    return Errno::EOPNOTSUPP if not $prot;
    $$offset_ref = $prot->io_seek ($$offset_ref, $whence);
    return $!;
}

# Return in $$AMOUNT_REF how much data can be read from the object
# without blocking for a "long time" (this should be the same meaning
# of "long time" used by the nonblocking flag).
sub io_readable {
    my ($prot, $amount_ref) = @_;
    local ($!);
    return Errno::EOPNOTSUPP if not $prot;
    $$amount_ref = $prot->io_readable ();
    return $!;
}

sub io_set_all_openmodes {
    my ($prot, $mode) = @_;
    local ($!);
    return Errno::EOPNOTSUPP if not $prot;
    $prot->io_set_all_openmodes ($mode);
    return $!;
}

sub io_get_openmodes {
    my ($prot, $mode_ref) = @_;
    local ($!);
    return Errno::EOPNOTSUPP if not $prot;
    $$mode_ref = $prot->io_get_openmodes ();
    return $!;
}

sub io_set_some_openmodes {
    my ($prot, $bits) = @_;
    local ($!);
    return Errno::EOPNOTSUPP if not $prot;
    $prot->io_set_some_openmodes ($bits);
    return $!;
}

sub io_clear_some_openmodes {
    my ($prot, $bits) = @_;
    local ($!);
    return Errno::EOPNOTSUPP if not $prot;
    $prot->io_clear_some_openmodes ($bits);
    return $!;
}

###
### File interface.
###

# Truncate file.
sub file_set_size {
    my ($prot, $size) = @_;
    local ($!);
    return Errno::EOPNOTSUPP if not $prot;
    $prot->file_set_size ($size);
    return $!;
}

1;
__END__

=head1 NAME

Hurd::Trivfs - Perl bindings for the Hurd trivial filesystem library

=head1 SYNOPSIS

  use Hurd::Trivfs;
  @ISA = ('Hurd::Trivfs');

  # override methods...

=head1 DESCRIPTION

This module gives Perl programs access to libtrivfs on the Hurd.

=head1 AUTHOR

John Tobey, jtobey@john-edwin-tobey.org

=head1 COPYING

Copyright (C) 1999,2000  John Tobey, jtobey@john-edwin-tobey.org

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

=head1 SEE ALSO

perl(1).

=cut
