Changes from Mark Glines in preparation for 0.07

- Remove the FUSE_DEBUG constant; we never actually implemented
  it to begin with.
- "make test" now uses the version of Fuse you've just built,
  not the one installed in /usr/lib/perl5.
- getattr test now allows blksize to vary between host and fuse
  fs, as this is not a bug.
- Add experimental support for threading.  The following minor
  API changes accommodate this:
- The nonexistent (yet documented) "unthreaded=>1" attribute
  has been replaced with the "threaded=>1" attribute, and this
  time it actually exists.
- Symbolic refs like "main::e_getattr" are now allowed for
  callbacks, because threaded mode needs to share() the
  callbacks, yet perl 5.8.7 does not allow share()ing code
  refs yet.  Direct code-refs are still supported as much
  as possible (currently, non-threaded mode).
- testsuite uses a multithreaded loopback.pl, when available.
- Update docs accordingly.  Update examples accordingly.

git-svn-id: svn+ssh://llin/home/dpavlin/private/svn/fuse/perl/trunk@19 6e4b0b00-1209-0410-87b2-b275959b5705

diff --git a/Changes b/Changes
index 3918cff..c1115f6 100644 (file)
--- a/Changes
+++ b/Changes
@@ -19,3 +19,23 @@ Revision history for Perl extension Fuse.
     - Add support for operations supported by FUSE 2.2.1
       (flush, release, fsync, extended attributes)
     - add mount options
+
+0.07 Sun Dec 25 10:37:00 PST 2005
+    - Remove the FUSE_DEBUG constant; we never actually implemented
+      it to begin with.
+    - "make test" now uses the version of Fuse you've just built,
+      not the one installed in /usr/lib/perl5.
+    - getattr test now allows blksize to vary between host and fuse
+      fs, as this is not a bug.
+    - Add experimental support for threading.  The following minor
+      API changes accommodate this:
+    - The nonexistent (yet documented) "unthreaded=>1" attribute
+      has been replaced with the "threaded=>1" attribute, and this
+      time it actually exists.
+    - Symbolic refs like "main::e_getattr" are now allowed for
+      callbacks, because threaded mode needs to share() the
+      callbacks, yet perl 5.8.7 does not allow share()ing code
+      refs yet.  Direct code-refs are still supported as much
+      as possible (currently, non-threaded mode).
+    - testsuite uses a multithreaded loopback.pl, when available.
+    - Update docs accordingly.  Update examples accordingly.

diff --git a/Fuse.pm b/Fuse.pm
index 4ee899a..b7f8795 100644 (file)
--- a/Fuse.pm
+++ b/Fuse.pm
@@ -5,6 +5,7 @@ use strict;
 use warnings;
 use Errno;
 use Carp;
+use Config;
 
 require Exporter;
 require DynaLoader;
@@ -20,17 +21,14 @@ our @ISA = qw(Exporter DynaLoader);
 # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
 # will save memory.
 our %EXPORT_TAGS = (
-                   'all' => [ qw(FUSE_DEBUG XATTR_CREATE XATTR_REPLACE) ],
-                   'debug' => [ qw(FUSE_DEBUG) ],
+                   'all' => [ qw(XATTR_CREATE XATTR_REPLACE) ],
                    'xattr' => [ qw(XATTR_CREATE XATTR_REPLACE) ]
                    );
 
 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
 
-our @EXPORT = qw(
-       FUSE_DEBUG
-);
-our $VERSION = '0.06';
+our @EXPORT = ();
+our $VERSION = '0.07';
 
 sub AUTOLOAD {
     # This AUTOLOAD is used to 'autoload' constants from the constant()
@@ -77,7 +75,9 @@ sub XATTR_REPLACE {
 bootstrap Fuse $VERSION;
 
 sub main {
-       my (@subs) = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
+       my (@subs) = (undef,undef,undef,undef,undef,undef,undef,undef,undef,undef,
+                     undef,undef,undef,undef,undef,undef,undef,undef,undef,undef,
+                     undef,undef,undef,undef,undef);
        my (@names) = qw(getattr readlink getdir mknod mkdir unlink rmdir symlink
                         rename link chmod chown truncate utime open read write statfs
                         flush release fsync setxattr getxattr listxattr removexattr);
@@ -96,12 +96,31 @@ sub main {
                        $subs[$mapping{$name}] = $subref;
                }
        }
-        foreach my $opt ( split(/,/,$otherargs{mountopts}) ) {
-          if ( ! exists($optmap{$opt}) ) {
-            croak "Use of an invalid mountopt argument";
-          }
-        }
-       perl_fuse_main($otherargs{debug},$otherargs{threaded},$otherargs{mountpoint},$otherargs{mountopts},@subs);
+       foreach my $opt ( split(/,/,$otherargs{mountopts}) ) {
+               if ( ! exists($optmap{$opt}) ) {
+                       croak "Use of an invalid mountopt argument";
+               }
+       }
+       if($otherargs{threaded}) {
+               # make sure threads are both available, and loaded.
+               if($Config{useithreads}) {
+                       if(exists($threads::{VERSION})) {
+                               if(exists($threads::shared::{VERSION})) {
+                                       # threads will work.
+                               } else {
+                                       carp("Thread support requires you to use threads::shared.\nThreads are disabled.\n");
+                                       $otherargs{threaded} = 0;
+                               }
+                       } else {
+                               carp("Thread support requires you to use threads and threads::shared.\nThreads are disabled.\n");
+                               $otherargs{threaded} = 0;
+                       }
+               } else {
+                       carp("Thread support was not compiled into this build of perl.\nThreads are disabled.\n");
+                       $otherargs{threaded} = 0;
+               }
+       }
+       perl_fuse_main($otherargs{debug},$otherargs{threaded},$otherargs{mountpoint},$otherargs{mountopts},@subs);
 }
 
 # Autoload methods go after =cut, and are processed by the autosplit program.
@@ -139,13 +158,10 @@ See their respective documentations, for more information.
 
 =head2 EXPORTED SYMBOLS
 
-FUSE_DEBUG by default.
+None by default.
 
 You can request all exportable symbols by using the tag ":all".
 
-You can request all debug symbols by using the tag ":debug".
-This will export FUSE_DEBUG.
-
 You can request the extended attribute symbols by using the tag ":xattr".
 This will export XATTR_CREATE and XATTR_REPLACE.
 
@@ -215,7 +231,8 @@ conditions and locking bugs, too.  Please also ensure any other perl modules
 you're using are also thread-safe.
 
 (If enabled, this option will cause a warning if your perl interpreter was not
-built with USE_ITHREADS.)
+built with USE_ITHREADS, or if you have failed to use threads or
+threads::shared.)
 
 =back
 

diff --git a/Fuse.xs b/Fuse.xs
index 57f0b60..cbbc80c 100644 (file)
--- a/Fuse.xs
+++ b/Fuse.xs
@@ -501,7 +501,7 @@ int _PLfuse_read (const char *file, char *buf, size_t buflen, off_t off) {
                                rv = 0;
                        }
                        if(rv > buflen)
-                               croak("%i: read() handler returned more than buflen! (%i > %i)",getpid(),rv,buflen);
+                               croak("read() handler returned more than buflen! (%i > %i)",rv,buflen);
                        if(rv)
                                memcpy(buf,SvPV_nolen(mysv),rv);
                }
@@ -857,7 +857,9 @@ PROTOTYPES: DISABLE
 void
 perl_fuse_main(...)
        PREINIT:
-       struct fuse_operations fops = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL};
+       struct fuse_operations fops = 
+               {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,
+                NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL};
        int i, fd, varnum = 0, debug, threaded, have_mnt;
        char *mountpoint;
        char *mountopts;
@@ -885,14 +887,21 @@ perl_fuse_main(...)
        mountopts = SvPV_nolen(ST(3));
        for(i=0;i<N_CALLBACKS;i++) {
                SV *var = ST(i+4);
-        /* allow symbolic references, or real code references. */
-               if((var != &PL_sv_undef) && (SvPOK(var) || (SvROK(var) && SvTYPE(SvRV(var)) == SVt_PVCV))) {
+               /* allow symbolic references, or real code references. */
+               if(SvOK(var) && (SvPOK(var) || (SvROK(var) && SvTYPE(SvRV(var)) == SVt_PVCV))) {
                        void **tmp1 = (void**)&_available_ops, **tmp2 = (void**)&fops;
                        tmp2[i] = tmp1[i];
+#ifdef FUSE_USE_ITHREADS
                        if(threaded)
                 /* note: under 5.8.7, this croaks for code references. */
                 SvSHARE(var);
+#endif
                        _PLfuse_callbacks[i] = var;
+               } else
+               if(SvOK(var)) {
+                       croak("invalid callback passed to perl_fuse_main "
+                             "(%s is not a string, code ref, or undef).\n",
+                             i+4,SvPVbyte_nolen(var));
                }
        }
        /* FIXME: need to pass fusermount arguments */

diff --git a/README b/README
index 625d2c2..30f1c84 100644 (file)
--- a/README
+++ b/README
@@ -29,7 +29,8 @@ This module requires the FUSE C library and the FUSE kernel module.
 See http://fuse.sourceforge.net/
 
 If you intend to use FUSE in threaded mode, you need a version of Perl which
-has been compiled with USE_ITHREADS.
+has been compiled with USE_ITHREADS.  Then, you need to use threads and
+threads::shared.
 
 
 COPYRIGHT AND LICENCE
@@ -66,14 +67,15 @@ subdirectory.  These are:
 
 BUGS
 
-Perl 5.8.7 does not support shared subroutine references.  Until this is
-fixed, if you use threaded mode, you need to use symbolic references (i.e.
-passing "main::cb" instead of \&cb).  This rules out closures, lexical
-subs and that sort of thing, but it does seem to work.
+At time of writing, Perl (5.8.7) did not support shared subroutine references.
+Symptoms include a cryptic error message like "Invalid value for shared scalar"
+from Fuse.pm.  Until this is fixed, if you use threaded mode, you need to use
+symbolic references (i.e. passing "main::cb" instead of \&cb).  This doesn't
+allow things like closures, lexical subs and that sort of thing, but it does
+work for me.
 
 The current test framework seems to work well, but the underlying mount/
-unmount infrastructure is a crock.  I am not pleased with that code.  I
-also wish there was a way to test without root permissions.
+unmount infrastructure is a crock.  I am not pleased with that code.
 
 While most things work, I do still have a TODO list:
 * "du -sb" reports a couple orders of magnitude too large a size.

diff --git a/examples/example.pl b/examples/example.pl
index 9ba1117..4a7b971 100644 (file)
--- a/examples/example.pl
+++ b/examples/example.pl
@@ -1,4 +1,5 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -w
+use strict;
 
 use Fuse;
 use POSIX qw(ENOENT EISDIR EINVAL);
@@ -81,10 +82,10 @@ my ($mountpoint) = "";
 $mountpoint = shift(@ARGV) if @ARGV;
 Fuse::main(
        mountpoint=>$mountpoint,
-       getattr=>\&e_getattr,
-       getdir=>\&e_getdir,
-       open=>\&e_open,
-       statfs=>\&e_statfs,
-       read=>\&e_read,
-       #debug=>1, threaded=>0
+       getattr=>"main::e_getattr",
+       getdir =>"main::e_getdir",
+       open   =>"main::e_open",
+       statfs =>"main::e_statfs",
+       read   =>"main::e_read",
+       threaded=>0
 );

diff --git a/examples/loopback.pl b/examples/loopback.pl
index 8d3f4fa..dd3fe15 100644 (file)
--- a/examples/loopback.pl
+++ b/examples/loopback.pl
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
-
 use strict;
+
 use Fuse;
 use IO::File;
 use POSIX qw(ENOENT ENOSYS EEXIST EPERM O_RDONLY O_RDWR O_APPEND O_CREAT);

diff --git a/examples/rmount.pl b/examples/rmount.pl
index 9ae1cc1..d8f90aa 100644 (file)
--- a/examples/rmount.pl
+++ b/examples/rmount.pl
@@ -1,5 +1,6 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -w
 
+# This example needs some work before it can support threads.
 use strict;
 use Net::SSH 'sshopen2';
 use IPC::Open2;
@@ -49,22 +50,21 @@ sub netlink {
        my ($str) = Dumper(\@_)."\n";
        $str = sprintf("%08i\n%s",length($str),$str);
        while(1) { # retry as necessary
-               my ($sig) = $SIG{ALRM};
                my ($VAR1);
                $VAR1 = undef;
                eval {
-                       $SIG{ALRM} = sub { die "timeout\n" };
+                       local $SIG{ALRM} = sub { die "timeout\n" };
                        alarm 10;
                        print WRITER $str;
                        my ($len, $data);
-                       if(read(READER,$len,9) == 9) {
-                               read(READER,$data,$len-length($data),length($data))
+                       $data = '';
+                       if(sysread(READER,$len,9) == 9) {
+                               sysread(READER,$data,$len-length($data),length($data))
                                        while(length($data) < $len);
                                eval $data;
                        }
+                       alarm 0;
                };
-               alarm 0;
-               $SIG{ALRM} = $sig;
                if(defined $VAR1) {
                        return wantarray ? @{$VAR1} : $$VAR1[0];
                }

diff --git a/test/helper.pm b/test/helper.pm
index 797b9b8..817b146 100644 (file)
--- a/test/helper.pm
+++ b/test/helper.pm
@@ -2,11 +2,13 @@
 package test::helper;
 use strict;
 use Exporter;
+use Config;
 use POSIX qw(WEXITSTATUS);
 our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
 @ISA = "Exporter";
 @EXPORT_OK = qw($_loop $_point $_pidfile $_real);
-our($_loop, $_point, $_pidfile, $_real) = ("examples/loopback.pl","/tmp/fusemnt-".$ENV{LOGNAME},"test/s/mounted.pid","/tmp/fusetest-".$ENV{LOGNAME});
+our($_loop, $_point, $_pidfile, $_real) = ("","/tmp/fusemnt-".$ENV{LOGNAME},"test/s/mounted.pid","/tmp/fusetest-".$ENV{LOGNAME});
+$_loop = $Config{useithreads} ? "examples/loopback_t.pl" : "examples/loopback.pl";
 if($0 !~ qr|s/u?mount\.t$|) {
        my ($reject) = 1;
        if(-f $_pidfile) {

diff --git a/test/s/mount.t b/test/s/mount.t
index b633dce..b24d449 100644 (file)
--- a/test/s/mount.t
+++ b/test/s/mount.t
@@ -12,7 +12,7 @@ if(!fork()) {
        mkdir $_point;
        mkdir $_real;
        `echo $$ >test/s/mounted.pid`;
-       exec("perl $_loop $_point");
+       exec("perl -Iblib/lib -Iblib/arch $_loop $_point");
        exit(1);
 }
 select(undef, undef, undef, 0.5);