fuse_dbi/fuse-couchdb/DBI.pm

#!/usr/bin/perl

package Fuse::DBI;

use 5.008;
use strict;
use warnings;

use POSIX qw(ENOENT EISDIR EINVAL ENOSYS O_RDWR);
use Fuse;
use DBI;
use Carp;
use Data::Dumper;

our $VERSION = '0.07';

# block size for this filesystem
use constant BLOCK => 1024;

=head1 NAME

Fuse::DBI - mount your database as filesystem and use it

=head1 SYNOPSIS

  use Fuse::DBI;
  Fuse::DBI->mount( ... );

See C<run> below for examples how to set parameters.

=head1 DESCRIPTION

This module will use C<Fuse> module, part of C<FUSE (Filesystem in USErspace)>
available at L<http://fuse.sourceforge.net/> to mount
your database as file system.

That will give you possibility to use normal file-system tools (cat, grep, vi)
to manipulate data in database.

It's actually opposite of Oracle's intention to put everything into database.


=head1 METHODS

=cut

=head2 mount

Mount your database as filesystem.

Let's suppose that your database have table C<files> with following structure:

 id:            int
 filename:      text
 size:          int
 content:       text
 writable:      boolean

Following is example how to mount table like that to C</mnt>:

  my $mnt = Fuse::DBI->mount({
        'filenames' => 'select id,filename,size,writable from files',
        'read' => 'select content from files where id = ?',
        'update' => 'update files set content = ? where id = ?',
        'dsn' => 'DBI:Pg:dbname=test_db',
        'user' => 'database_user',
        'password' => 'database_password',
        'invalidate' => sub { ... },
  });

Options:

=over 5

=item filenames

SQL query which returns C<id> (unique id for that row), C<filename>,
C<size> and C<writable> boolean flag.

=item read

SQL query which returns only one column with content of file and has
placeholder C<?> for C<id>.

=item update

SQL query with two pace-holders, one for new content and one for C<id>.

=item dsn

C<DBI> dsn to connect to (contains database driver and name of database).

=item user

User with which to connect to database

=item password

Password for connecting to database

=item invalidate

Optional anonymous code reference which will be executed when data is updated in
database. It can be used as hook to delete cache (for example on-disk-cache)
which is created from data edited through C<Fuse::DBI>.

=item fork

Optional flag which forks after mount so that executing script will continue
running. Implementation is experimental.

=back

=cut

my $dbh;
my $sth;
my $ctime_start;

sub read_filenames;
sub fuse_module_loaded;

# evil, evil way to solve this. It makes this module non-reentrant. But, since
# fuse calls another copy of this script for each mount anyway, this shouldn't
# be a problem.
my $fuse_self;

sub mount {
        my $class = shift;
        my $self = {};
        bless($self, $class);

        my $arg = shift;

        print Dumper($arg);

        unless ($self->fuse_module_loaded) {
                print STDERR "no fuse module loaded. Trying sudo modprobe fuse!\n";
                system "sudo modprobe fuse" || die "can't modprobe fuse using sudo!\n";
        }

        carp "mount needs 'dsn' to connect to (e.g. dsn => 'DBI:Pg:dbname=test')" unless ($arg->{'dsn'});
        carp "mount needs 'mount' as mountpoint" unless ($arg->{'mount'});

        # save (some) arguments in self
        foreach (qw(mount invalidate)) {
                $self->{$_} = $arg->{$_};
        }

        foreach (qw(filenames read update)) {
                carp "mount needs '$_' SQL" unless ($arg->{$_});
        }

        $ctime_start = time();

        my $pid;
        if ($arg->{'fork'}) {
                $pid = fork();
                die "fork() failed: $!" unless defined $pid;
                # child will return to caller
                if ($pid) {
                        my $counter = 4;
                        while ($counter && ! $self->is_mounted) {
                                select(undef, undef, undef, 0.5);
                                $counter--;
                        }
                        if ($self->is_mounted) {
                                return $self;
                        } else {
                                return undef;
                        }
                }
        }

        $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;

        $sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();

        $sth->{'read'} = $dbh->prepare($arg->{'read'}) || die $dbh->errstr();
        $sth->{'update'} = $dbh->prepare($arg->{'update'}) || die $dbh->errstr();


        $self->{'sth'} = $sth;

        $self->{'read_filenames'} = sub { $self->read_filenames };
        $self->read_filenames;

        $fuse_self = \$self;

        Fuse::main(
                mountpoint=>$arg->{'mount'},
                getattr=>\&e_getattr,
                getdir=>\&e_getdir,
                open=>\&e_open,
                statfs=>\&e_statfs,
                read=>\&e_read,
                write=>\&e_write,
                utime=>\&e_utime,
                truncate=>\&e_truncate,
                unlink=>\&e_unlink,
                rmdir=>\&e_unlink,
                debug=>0,
        );
        
        exit(0) if ($arg->{'fork'});

        return 1;

};

=head2 is_mounted

Check if fuse filesystem is mounted

  if ($mnt->is_mounted) { ... }

=cut

sub is_mounted {
        my $self = shift;

        my $mounted = 0;
        my $mount = $self->{'mount'} || confess "can't find mount point!";
        if (open(MTAB, "/etc/mtab")) {
                while(<MTAB>) {
                        $mounted = 1 if (/ $mount fuse /i);
                }
                close(MTAB);
        } else {
                warn "can't open /etc/mtab: $!";
        }

        return $mounted;
}


=head2 umount

Unmount your database as filesystem.

  $mnt->umount;

This will also kill background process which is translating
database to filesystem.

=cut

sub umount {
        my $self = shift;

        if ($self->{'mount'} && $self->is_mounted) {
                system "( fusermount -u ".$self->{'mount'}." 2>&1 ) >/dev/null";
                if ($self->is_mounted) {
                        system "sudo umount ".$self->{'mount'} ||
                        return 0;
                }
                return 1;
        }

        return 0;
}

$SIG{'INT'} = sub {
        if ($fuse_self && $$fuse_self->umount) {
                print STDERR "umount called by SIG INT\n";
        }
};

$SIG{'QUIT'} = sub {
        if ($fuse_self && $$fuse_self->umount) {
                print STDERR "umount called by SIG QUIT\n";
        }
};

sub DESTROY {
        my $self = shift;
        if ($self->umount) {
                print STDERR "umount called by DESTROY\n";
        }
}

=head2 fuse_module_loaded

Checks if C<fuse> module is loaded in kernel.

  die "no fuse module loaded in kernel"
        unless (Fuse::DBI::fuse_module_loaded);

This function in called by C<mount>, but might be useful alone also.

=cut

sub fuse_module_loaded {
        my $lsmod = `lsmod`;
        die "can't start lsmod: $!" unless ($lsmod);
        if ($lsmod =~ m/fuse/s) {
                return 1;
        } else {
                return 0;
        }
}

my %files;

sub read_filenames {
        my $self = shift;

        my $sth = $self->{'sth'} || die "no sth argument";

        # create empty filesystem
        (%files) = (
                '.' => {
                        type => 0040,
                        mode => 0755,
                },
                '..' => {
                        type => 0040,
                        mode => 0755,
                },
        #       a => {
        #               cont => "File 'a'.\n",
        #               type => 0100,
        #               ctime => time()-2000
        #       },
        );

        # fetch new filename list from database
        $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();

        # read them in with sesible defaults
        while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
                $files{$row->{'filename'}} = {
                        size => $row->{'size'},
                        mode => $row->{'writable'} ? 0644 : 0444,
                        id => $row->{'id'} || 99,
                };

                my $d;
                foreach (split(m!/!, $row->{'filename'})) {
                        # first, entry is assumed to be file
                        if ($d) {
                                $files{$d} = {
                                                mode => 0755,
                                                type => 0040
                                };
                                $files{$d.'/.'} = {
                                                mode => 0755,
                                                type => 0040
                                };
                                $files{$d.'/..'} = {
                                                mode => 0755,
                                                type => 0040
                                };
                        }
                        $d .= "/" if ($d);
                        $d .= "$_";
                }
        }

        print "found ",scalar(keys %files)," files\n";
}


sub filename_fixup {
        my ($file) = shift;
        $file =~ s,^/,,;
        $file = '.' unless length($file);
        return $file;
}

sub e_getattr {
        my ($file) = filename_fixup(shift);
        $file =~ s,^/,,;
        $file = '.' unless length($file);
        return -ENOENT() unless exists($files{$file});
        my ($size) = $files{$file}{size} || BLOCK;
        my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,int(($size+BLOCK-1)/BLOCK),0,0,1,BLOCK);
        my ($atime, $ctime, $mtime);
        $atime = $ctime = $mtime = $files{$file}{ctime} || $ctime_start;

        my ($modes) = (($files{$file}{type} || 0100)<<9) + $files{$file}{mode};

        # 2 possible types of return values:
        #return -ENOENT(); # or any other error you care to
        #print "getattr($file) ",join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n";
        return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
}

sub e_getdir {
        my ($dirname) = shift;
        $dirname =~ s!^/!!;
        # return as many text filenames as you like, followed by the retval.
        print((scalar keys %files)." files total\n");
        my %out;
        foreach my $f (sort keys %files) {
                if ($dirname) {
                        if ($f =~ s/^\Q$dirname\E\///) {
                                $out{$f}++ if ($f =~ /^[^\/]+$/);
                        }
                } else {
                        $out{$f}++ if ($f =~ /^[^\/]+$/);
                }
        }
        if (! %out) {
                $out{'no files? bug?'}++;
        }
        print scalar keys %out," files in dir '$dirname'\n";
        print "## ",join(" ",keys %out),"\n";
        return (keys %out),0;
}

sub read_content {
        my ($file,$id) = @_;

        die "read_content needs file and id" unless ($file && $id);

        $sth->{'read'}->execute($id) || die $sth->{'read'}->errstr;
        $files{$file}{cont} = $sth->{'read'}->fetchrow_array;
        # I should modify ctime only if content in database changed
        #$files{$file}{ctime} = time() unless ($files{$file}{ctime});
        print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
}


sub e_open {
        # VFS sanity check; it keeps all the necessary state, not much to do here.
        my $file = filename_fixup(shift);
        my $flags = shift;

        return -ENOENT() unless exists($files{$file});
        return -EISDIR() unless exists($files{$file}{id});

        read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});

        print "open '$file' ",length($files{$file}{cont})," bytes\n";
        return 0;
}

sub e_read {
        # return an error numeric, or binary/text string.
        # (note: 0 means EOF, "0" will give a byte (ascii "0")
        # to the reading program)
        my ($file) = filename_fixup(shift);
        my ($buf_len,$off) = @_;

        return -ENOENT() unless exists($files{$file});

        my $len = length($files{$file}{cont});

        print "read '$file' [$len bytes] offset $off length $buf_len\n";

        return -EINVAL() if ($off > $len);
        return 0 if ($off == $len);

        $buf_len = $len-$off if ($len - $off < $buf_len);

        return substr($files{$file}{cont},$off,$buf_len);
}

sub clear_cont {
        print "transaction rollback\n";
        $dbh->rollback || die $dbh->errstr;
        print "invalidate all cached content\n";
        foreach my $f (keys %files) {
                delete $files{$f}{cont};
                delete $files{$f}{ctime};
        }
        print "begin new transaction\n";
        #$dbh->begin_work || die $dbh->errstr;
}


sub update_db {
        my $file = shift || die;

        $files{$file}{ctime} = time();

        my ($cont,$id) = (
                $files{$file}{cont},
                $files{$file}{id}
        );

        if (!$sth->{'update'}->execute($cont,$id)) {
                print "update problem: ",$sth->{'update'}->errstr;
                clear_cont;
                return 0;
        } else {
                if (! $dbh->commit) {
                        print "ERROR: commit problem: ",$sth->{'update'}->errstr;
                        clear_cont;
                        return 0;
                }
                print "updated '$file' [",$files{$file}{id},"]\n";

                $$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
        }
        return 1;
}

sub e_write {
        my $file = filename_fixup(shift);
        my ($buffer,$off) = @_;

        return -ENOENT() unless exists($files{$file});

        my $cont = $files{$file}{cont};
        my $len = length($cont);

        print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";

        $files{$file}{cont} = "";

        $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
        $files{$file}{cont} .= $buffer;
        $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);

        $files{$file}{size} = length($files{$file}{cont});

        if (! update_db($file)) {
                return -ENOSYS();
        } else {
                return length($buffer);
        }
}

sub e_truncate {
        my $file = filename_fixup(shift);
        my $size = shift;

        print "truncate to $size\n";

        $files{$file}{cont} = substr($files{$file}{cont},0,$size);
        $files{$file}{size} = $size;
        return 0
};


sub e_utime {
        my ($atime,$mtime,$file) = @_;
        $file = filename_fixup($file);

        return -ENOENT() unless exists($files{$file});

        print "utime '$file' $atime $mtime\n";

        $files{$file}{time} = $mtime;
        return 0;
}

sub e_statfs {

        my $size = 0;
        my $inodes = 0;

        foreach my $f (keys %files) {
                if ($f !~ /(^|\/)\.\.?$/) {
                        $size += $files{$f}{size} || 0;
                        $inodes++;
                }
                print "$inodes: $f [$size]\n";
        }

        $size = int(($size+BLOCK-1)/BLOCK);

        my @ret = (255, $inodes, 1, $size, $size-1, BLOCK);

        #print "statfs: ",join(",",@ret),"\n";

        return @ret;
}

sub e_unlink {
        my $file = filename_fixup(shift);

#       if (exists( $dirs{$file} )) {
#               print "unlink '$file' will re-read template names\n";
#               print Dumper($fuse_self);
#               $$fuse_self->{'read_filenames'}->();
#               return 0;
        if (exists( $files{$file} )) {
                print "unlink '$file' will invalidate cache\n";
                read_content($file,$files{$file}{id});
                return 0;
        }

        return -ENOENT();
}
1;
__END__

=head1 EXPORT

Nothing.

=head1 BUGS

Size information (C<ls -s>) is wrong. It's a problem in upstream Fuse module
(for which I'm to blame lately), so when it gets fixes, C<Fuse::DBI> will
automagically pick it up.

=head1 SEE ALSO

C<FUSE (Filesystem in USErspace)> website
L<http://fuse.sourceforge.net/>

Example for WebGUI which comes with this distribution in
directory C<examples/webgui.pl>. It also contains a lot of documentation
about design of this module, usage and limitations.

=head1 AUTHOR

Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2004 by Dobrica Pavlinusic

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.4 or,
at your option, any later version of Perl 5 you may have available.


=cut

1	dpavlin	1	#!/usr/bin/perl
2
3	dpavlin	9	package Fuse::DBI;
4
5			use 5.008;
6			use strict;
7			use warnings;
8
9	dpavlin	7	use POSIX qw(ENOENT EISDIR EINVAL ENOSYS O_RDWR);
10	dpavlin	1	use Fuse;
11			use DBI;
12	dpavlin	11	use Carp;
13			use Data::Dumper;
14	dpavlin	1
15	dpavlin	47	our $VERSION = '0.07';
16	dpavlin	1
17	dpavlin	52	# block size for this filesystem
18			use constant BLOCK => 1024;
19
20	dpavlin	9	=head1 NAME
21	dpavlin	1
22	dpavlin	9	Fuse::DBI - mount your database as filesystem and use it
23	dpavlin	1
24	dpavlin	9	=head1 SYNOPSIS
25	dpavlin	6
26	dpavlin	9	use Fuse::DBI;
27	dpavlin	11	Fuse::DBI->mount( ... );
28	dpavlin	1
29	dpavlin	28	See C<run> below for examples how to set parameters.
30	dpavlin	1
31	dpavlin	9	=head1 DESCRIPTION
32	dpavlin	1
33	dpavlin	23	This module will use C<Fuse> module, part of C<FUSE (Filesystem in USErspace)>
34	dpavlin	36	available at L<http://fuse.sourceforge.net/> to mount
35	dpavlin	9	your database as file system.
36	dpavlin	1
37	dpavlin	28	That will give you possibility to use normal file-system tools (cat, grep, vi)
38	dpavlin	9	to manipulate data in database.
39	dpavlin	1
40	dpavlin	9	It's actually opposite of Oracle's intention to put everything into database.
41	dpavlin	1
42
43	dpavlin	9	=head1 METHODS
44
45			=cut
46
47	dpavlin	11	=head2 mount
48	dpavlin	9
49			Mount your database as filesystem.
50
51	dpavlin	28	Let's suppose that your database have table C<files> with following structure:
52
53			id: int
54			filename: text
55			size: int
56			content: text
57			writable: boolean
58
59			Following is example how to mount table like that to C</mnt>:
60
61	dpavlin	11	my $mnt = Fuse::DBI->mount({
62	dpavlin	28	'filenames' => 'select id,filename,size,writable from files',
63			'read' => 'select content from files where id = ?',
64			'update' => 'update files set content = ? where id = ?',
65			'dsn' => 'DBI:Pg:dbname=test_db',
66			'user' => 'database_user',
67			'password' => 'database_password',
68			'invalidate' => sub { ... },
69	dpavlin	9	});
70
71	dpavlin	28	Options:
72
73			=over 5
74
75			=item filenames
76
77			SQL query which returns C<id> (unique id for that row), C<filename>,
78			C<size> and C<writable> boolean flag.
79
80			=item read
81
82			SQL query which returns only one column with content of file and has
83			placeholder C<?> for C<id>.
84
85			=item update
86
87			SQL query with two pace-holders, one for new content and one for C<id>.
88
89			=item dsn
90
91			C<DBI> dsn to connect to (contains database driver and name of database).
92
93			=item user
94
95			User with which to connect to database
96
97			=item password
98
99			Password for connecting to database
100
101			=item invalidate
102
103			Optional anonymous code reference which will be executed when data is updated in
104			database. It can be used as hook to delete cache (for example on-disk-cache)
105			which is created from data edited through C<Fuse::DBI>.
106
107			=item fork
108
109			Optional flag which forks after mount so that executing script will continue
110			running. Implementation is experimental.
111
112			=back
113
114	dpavlin	9	=cut
115
116			my $dbh;
117			my $sth;
118			my $ctime_start;
119
120	dpavlin	11	sub read_filenames;
121	dpavlin	21	sub fuse_module_loaded;
122	dpavlin	9
123	dpavlin	24	# evil, evil way to solve this. It makes this module non-reentrant. But, since
124			# fuse calls another copy of this script for each mount anyway, this shouldn't
125			# be a problem.
126			my $fuse_self;
127
128	dpavlin	11	sub mount {
129			my $class = shift;
130			my $self = {};
131			bless($self, $class);
132	dpavlin	9
133	dpavlin	11	my $arg = shift;
134	dpavlin	9
135	dpavlin	11	print Dumper($arg);
136
137	dpavlin	51	unless ($self->fuse_module_loaded) {
138			print STDERR "no fuse module loaded. Trying sudo modprobe fuse!\n";
139			system "sudo modprobe fuse" \|\| die "can't modprobe fuse using sudo!\n";
140			}
141
142	dpavlin	11	carp "mount needs 'dsn' to connect to (e.g. dsn => 'DBI:Pg:dbname=test')" unless ($arg->{'dsn'});
143			carp "mount needs 'mount' as mountpoint" unless ($arg->{'mount'});
144
145	dpavlin	12	# save (some) arguments in self
146	dpavlin	24	foreach (qw(mount invalidate)) {
147			$self->{$_} = $arg->{$_};
148			}
149	dpavlin	12
150	dpavlin	9	foreach (qw(filenames read update)) {
151	dpavlin	11	carp "mount needs '$_' SQL" unless ($arg->{$_});
152	dpavlin	9	}
153
154	dpavlin	21	$ctime_start = time();
155	dpavlin	9
156	dpavlin	22	my $pid;
157	dpavlin	21	if ($arg->{'fork'}) {
158	dpavlin	22	$pid = fork();
159	dpavlin	21	die "fork() failed: $!" unless defined $pid;
160			# child will return to caller
161			if ($pid) {
162	dpavlin	47	my $counter = 4;
163			while ($counter && ! $self->is_mounted) {
164			select(undef, undef, undef, 0.5);
165			$counter--;
166			}
167			if ($self->is_mounted) {
168			return $self;
169			} else {
170			return undef;
171			}
172	dpavlin	21	}
173			}
174	dpavlin	9
175	dpavlin	21	$dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) \|\| die $DBI::errstr;
176
177	dpavlin	26	$sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) \|\| die $dbh->errstr();
178	dpavlin	9
179			$sth->{'read'} = $dbh->prepare($arg->{'read'}) \|\| die $dbh->errstr();
180			$sth->{'update'} = $dbh->prepare($arg->{'update'}) \|\| die $dbh->errstr();
181
182	dpavlin	26
183			$self->{'sth'} = $sth;
184
185			$self->{'read_filenames'} = sub { $self->read_filenames };
186	dpavlin	21	$self->read_filenames;
187	dpavlin	9
188	dpavlin	26	$fuse_self = \$self;
189
190	dpavlin	22	Fuse::main(
191	dpavlin	21	mountpoint=>$arg->{'mount'},
192			getattr=>\&e_getattr,
193			getdir=>\&e_getdir,
194			open=>\&e_open,
195			statfs=>\&e_statfs,
196			read=>\&e_read,
197			write=>\&e_write,
198			utime=>\&e_utime,
199			truncate=>\&e_truncate,
200			unlink=>\&e_unlink,
201	dpavlin	26	rmdir=>\&e_unlink,
202	dpavlin	21	debug=>0,
203			);
204	dpavlin	26
205	dpavlin	22	exit(0) if ($arg->{'fork'});
206
207			return 1;
208
209	dpavlin	9	};
210
211	dpavlin	47	=head2 is_mounted
212
213			Check if fuse filesystem is mounted
214
215			if ($mnt->is_mounted) { ... }
216
217			=cut
218
219			sub is_mounted {
220			my $self = shift;
221
222			my $mounted = 0;
223			my $mount = $self->{'mount'} \|\| confess "can't find mount point!";
224			if (open(MTAB, "/etc/mtab")) {
225			while(<MTAB>) {
226			$mounted = 1 if (/ $mount fuse /i);
227			}
228			close(MTAB);
229			} else {
230			warn "can't open /etc/mtab: $!";
231			}
232
233			return $mounted;
234			}
235
236
237	dpavlin	11	=head2 umount
238
239			Unmount your database as filesystem.
240
241			$mnt->umount;
242
243			This will also kill background process which is translating
244			database to filesystem.
245
246			=cut
247
248			sub umount {
249			my $self = shift;
250
251	dpavlin	47	if ($self->{'mount'} && $self->is_mounted) {
252	dpavlin	53	system "( fusermount -u ".$self->{'mount'}." 2>&1 ) >/dev/null";
253			if ($self->is_mounted) {
254	dpavlin	51	system "sudo umount ".$self->{'mount'} \|\|
255			return 0;
256	dpavlin	53	}
257	dpavlin	47	return 1;
258			}
259	dpavlin	40
260	dpavlin	47	return 0;
261	dpavlin	21	}
262
263	dpavlin	26	$SIG{'INT'} = sub {
264	dpavlin	40	if ($fuse_self && $$fuse_self->umount) {
265			print STDERR "umount called by SIG INT\n";
266			}
267	dpavlin	26	};
268	dpavlin	24
269	dpavlin	40	$SIG{'QUIT'} = sub {
270			if ($fuse_self && $$fuse_self->umount) {
271			print STDERR "umount called by SIG QUIT\n";
272			}
273			};
274
275	dpavlin	24	sub DESTROY {
276			my $self = shift;
277	dpavlin	40	if ($self->umount) {
278			print STDERR "umount called by DESTROY\n";
279			}
280	dpavlin	24	}
281
282	dpavlin	21	=head2 fuse_module_loaded
283
284			Checks if C<fuse> module is loaded in kernel.
285
286			die "no fuse module loaded in kernel"
287			unless (Fuse::DBI::fuse_module_loaded);
288
289	dpavlin	28	This function in called by C<mount>, but might be useful alone also.
290	dpavlin	21
291			=cut
292
293			sub fuse_module_loaded {
294			my $lsmod = `lsmod`;
295			die "can't start lsmod: $!" unless ($lsmod);
296			if ($lsmod =~ m/fuse/s) {
297			return 1;
298	dpavlin	12	} else {
299	dpavlin	21	return 0;
300	dpavlin	12	}
301	dpavlin	11	}
302
303	dpavlin	9	my %files;
304	dpavlin	1
305	dpavlin	9	sub read_filenames {
306	dpavlin	11	my $self = shift;
307
308	dpavlin	26	my $sth = $self->{'sth'} \|\| die "no sth argument";
309
310	dpavlin	9	# create empty filesystem
311			(%files) = (
312			'.' => {
313			type => 0040,
314			mode => 0755,
315			},
316	dpavlin	40	'..' => {
317			type => 0040,
318			mode => 0755,
319			},
320	dpavlin	9	# a => {
321			# cont => "File 'a'.\n",
322			# type => 0100,
323			# ctime => time()-2000
324			# },
325			);
326	dpavlin	1
327	dpavlin	9	# fetch new filename list from database
328			$sth->{'filenames'}->execute() \|\| die $sth->{'filenames'}->errstr();
329
330			# read them in with sesible defaults
331			while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
332			$files{$row->{'filename'}} = {
333			size => $row->{'size'},
334			mode => $row->{'writable'} ? 0644 : 0444,
335			id => $row->{'id'} \|\| 99,
336			};
337
338			my $d;
339			foreach (split(m!/!, $row->{'filename'})) {
340			# first, entry is assumed to be file
341			if ($d) {
342			$files{$d} = {
343			mode => 0755,
344			type => 0040
345			};
346			$files{$d.'/.'} = {
347			mode => 0755,
348			type => 0040
349			};
350			$files{$d.'/..'} = {
351			mode => 0755,
352			type => 0040
353			};
354			}
355			$d .= "/" if ($d);
356			$d .= "$_";
357	dpavlin	1	}
358			}
359	dpavlin	9
360	dpavlin	51	print "found ",scalar(keys %files)," files\n";
361	dpavlin	1	}
362
363
364			sub filename_fixup {
365			my ($file) = shift;
366			$file =~ s,^/,,;
367			$file = '.' unless length($file);
368			return $file;
369			}
370
371			sub e_getattr {
372			my ($file) = filename_fixup(shift);
373			$file =~ s,^/,,;
374			$file = '.' unless length($file);
375			return -ENOENT() unless exists($files{$file});
376	dpavlin	52	my ($size) = $files{$file}{size} \|\| BLOCK;
377			my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,int(($size+BLOCK-1)/BLOCK),0,0,1,BLOCK);
378	dpavlin	1	my ($atime, $ctime, $mtime);
379			$atime = $ctime = $mtime = $files{$file}{ctime} \|\| $ctime_start;
380
381			my ($modes) = (($files{$file}{type} \|\| 0100)<<9) + $files{$file}{mode};
382
383			# 2 possible types of return values:
384			#return -ENOENT(); # or any other error you care to
385	dpavlin	53	#print "getattr($file) ",join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n";
386	dpavlin	1	return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
387			}
388
389			sub e_getdir {
390			my ($dirname) = shift;
391			$dirname =~ s!^/!!;
392			# return as many text filenames as you like, followed by the retval.
393			print((scalar keys %files)." files total\n");
394			my %out;
395	dpavlin	13	foreach my $f (sort keys %files) {
396	dpavlin	1	if ($dirname) {
397	dpavlin	32	if ($f =~ s/^\Q$dirname\E\///) {
398	dpavlin	13	$out{$f}++ if ($f =~ /^[^\/]+$/);
399			}
400	dpavlin	1	} else {
401			$out{$f}++ if ($f =~ /^[^\/]+$/);
402			}
403			}
404			if (! %out) {
405			$out{'no files? bug?'}++;
406			}
407	dpavlin	8	print scalar keys %out," files in dir '$dirname'\n";
408	dpavlin	13	print "## ",join(" ",keys %out),"\n";
409	dpavlin	1	return (keys %out),0;
410			}
411
412	dpavlin	21	sub read_content {
413			my ($file,$id) = @_;
414
415			die "read_content needs file and id" unless ($file && $id);
416
417			$sth->{'read'}->execute($id) \|\| die $sth->{'read'}->errstr;
418			$files{$file}{cont} = $sth->{'read'}->fetchrow_array;
419	dpavlin	31	# I should modify ctime only if content in database changed
420			#$files{$file}{ctime} = time() unless ($files{$file}{ctime});
421	dpavlin	21	print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
422			}
423
424
425	dpavlin	1	sub e_open {
426			# VFS sanity check; it keeps all the necessary state, not much to do here.
427	dpavlin	6	my $file = filename_fixup(shift);
428			my $flags = shift;
429
430	dpavlin	1	return -ENOENT() unless exists($files{$file});
431			return -EISDIR() unless exists($files{$file}{id});
432	dpavlin	6
433	dpavlin	21	read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
434
435	dpavlin	3	print "open '$file' ",length($files{$file}{cont})," bytes\n";
436	dpavlin	1	return 0;
437			}
438
439			sub e_read {
440	dpavlin	3	# return an error numeric, or binary/text string.
441			# (note: 0 means EOF, "0" will give a byte (ascii "0")
442			# to the reading program)
443	dpavlin	1	my ($file) = filename_fixup(shift);
444	dpavlin	8	my ($buf_len,$off) = @_;
445	dpavlin	3
446	dpavlin	1	return -ENOENT() unless exists($files{$file});
447	dpavlin	3
448			my $len = length($files{$file}{cont});
449
450	dpavlin	8	print "read '$file' [$len bytes] offset $off length $buf_len\n";
451	dpavlin	3
452			return -EINVAL() if ($off > $len);
453			return 0 if ($off == $len);
454
455	dpavlin	21	$buf_len = $len-$off if ($len - $off < $buf_len);
456	dpavlin	3
457	dpavlin	8	return substr($files{$file}{cont},$off,$buf_len);
458	dpavlin	1	}
459
460	dpavlin	6	sub clear_cont {
461	dpavlin	7	print "transaction rollback\n";
462			$dbh->rollback \|\| die $dbh->errstr;
463	dpavlin	6	print "invalidate all cached content\n";
464			foreach my $f (keys %files) {
465			delete $files{$f}{cont};
466	dpavlin	31	delete $files{$f}{ctime};
467	dpavlin	6	}
468	dpavlin	7	print "begin new transaction\n";
469	dpavlin	21	#$dbh->begin_work \|\| die $dbh->errstr;
470	dpavlin	6	}
471
472
473			sub update_db {
474			my $file = shift \|\| die;
475
476	dpavlin	8	$files{$file}{ctime} = time();
477
478	dpavlin	21	my ($cont,$id) = (
479			$files{$file}{cont},
480			$files{$file}{id}
481			);
482
483			if (!$sth->{'update'}->execute($cont,$id)) {
484	dpavlin	9	print "update problem: ",$sth->{'update'}->errstr;
485	dpavlin	6	clear_cont;
486			return 0;
487			} else {
488	dpavlin	7	if (! $dbh->commit) {
489	dpavlin	9	print "ERROR: commit problem: ",$sth->{'update'}->errstr;
490	dpavlin	6	clear_cont;
491			return 0;
492			}
493			print "updated '$file' [",$files{$file}{id},"]\n";
494	dpavlin	24
495	dpavlin	26	$$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
496	dpavlin	6	}
497			return 1;
498			}
499
500			sub e_write {
501			my $file = filename_fixup(shift);
502	dpavlin	18	my ($buffer,$off) = @_;
503	dpavlin	6
504			return -ENOENT() unless exists($files{$file});
505
506	dpavlin	18	my $cont = $files{$file}{cont};
507			my $len = length($cont);
508	dpavlin	6
509	dpavlin	18	print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
510	dpavlin	6
511	dpavlin	18	$files{$file}{cont} = "";
512	dpavlin	6
513	dpavlin	18	$files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
514			$files{$file}{cont} .= $buffer;
515	dpavlin	21	$files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
516	dpavlin	18
517			$files{$file}{size} = length($files{$file}{cont});
518
519	dpavlin	6	if (! update_db($file)) {
520			return -ENOSYS();
521			} else {
522	dpavlin	18	return length($buffer);
523	dpavlin	6	}
524			}
525
526			sub e_truncate {
527			my $file = filename_fixup(shift);
528			my $size = shift;
529
530	dpavlin	18	print "truncate to $size\n";
531
532	dpavlin	6	$files{$file}{cont} = substr($files{$file}{cont},0,$size);
533	dpavlin	18	$files{$file}{size} = $size;
534	dpavlin	6	return 0
535			};
536
537
538			sub e_utime {
539			my ($atime,$mtime,$file) = @_;
540			$file = filename_fixup($file);
541
542			return -ENOENT() unless exists($files{$file});
543
544	dpavlin	8	print "utime '$file' $atime $mtime\n";
545
546	dpavlin	6	$files{$file}{time} = $mtime;
547			return 0;
548			}
549
550	dpavlin	51	sub e_statfs {
551	dpavlin	1
552	dpavlin	51	my $size = 0;
553			my $inodes = 0;
554
555			foreach my $f (keys %files) {
556			if ($f !~ /(^\|\/)\.\.?$/) {
557			$size += $files{$f}{size} \|\| 0;
558			$inodes++;
559			}
560			print "$inodes: $f [$size]\n";
561			}
562
563	dpavlin	52	$size = int(($size+BLOCK-1)/BLOCK);
564	dpavlin	51
565	dpavlin	52	my @ret = (255, $inodes, 1, $size, $size-1, BLOCK);
566	dpavlin	51
567	dpavlin	53	#print "statfs: ",join(",",@ret),"\n";
568	dpavlin	51
569			return @ret;
570			}
571
572	dpavlin	21	sub e_unlink {
573			my $file = filename_fixup(shift);
574
575	dpavlin	51	# if (exists( $dirs{$file} )) {
576			# print "unlink '$file' will re-read template names\n";
577			# print Dumper($fuse_self);
578			# $$fuse_self->{'read_filenames'}->();
579			# return 0;
580			if (exists( $files{$file} )) {
581	dpavlin	26	print "unlink '$file' will invalidate cache\n";
582			read_content($file,$files{$file}{id});
583			return 0;
584			}
585	dpavlin	21
586	dpavlin	26	return -ENOENT();
587	dpavlin	21	}
588	dpavlin	9	1;
589			__END__
590
591			=head1 EXPORT
592
593			Nothing.
594
595	dpavlin	40	=head1 BUGS
596
597			Size information (C<ls -s>) is wrong. It's a problem in upstream Fuse module
598			(for which I'm to blame lately), so when it gets fixes, C<Fuse::DBI> will
599			automagically pick it up.
600
601	dpavlin	9	=head1 SEE ALSO
602
603			C<FUSE (Filesystem in USErspace)> website
604	dpavlin	36	L<http://fuse.sourceforge.net/>
605	dpavlin	9
606	dpavlin	28	Example for WebGUI which comes with this distribution in
607	dpavlin	30	directory C<examples/webgui.pl>. It also contains a lot of documentation
608	dpavlin	28	about design of this module, usage and limitations.
609
610	dpavlin	9	=head1 AUTHOR
611
612			Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
613
614			=head1 COPYRIGHT AND LICENSE
615
616			Copyright (C) 2004 by Dobrica Pavlinusic
617
618			This library is free software; you can redistribute it and/or modify
619			it under the same terms as Perl itself, either Perl version 5.8.4 or,
620			at your option, any later version of Perl 5 you may have available.
621
622
623			=cut
624